【ExcelVBA】質問２点。困っています…

質問

とある機能のマクロを作っているのですが、以下の２点の作り方がわかりません。。。
ネットで調べても参考になりそうな情報がヒットせず、困っています。
ヒントだけでも結構ですので、ご教授頂けますと助かります。

★１
マクロを記述したいファイルが保存されている所と同じ階層に、「チェック」というフォルダがあります。
このフォルダ内のファイルの有無をチェックし、ファイルが存在したら「削除していいですか？」のMSGボックスを出し、「はい」なら全件削除、「いいえ」なら何もせずに処理終了。
（もし拡張子毎に対応しなければならないのでしたら、Excelのファイルの有無のチェックだけでOKです）

★２
AA列：数値が入っている（行数未確定だが、AC列と同じ行数）
AB列：全て未入力
AC列：数値が入っている（行数未確定だが、AA列と同じ行数）

…というファイルがあるのですが、

AA列の数値の頭に「1」を付加
AB列は何もしない
AC列の数値の頭に「30」を付加

以上の処理を行った編集後の値をBCD列の同じ行にコピーする。
ただし、1～2行目はヘッダなので、編集・コピーは3行目から行う。

回答No.2

onlyrom · ベストアンサー

ま、いくら簡単とはいえ習い始めはなかなかでしょうから、シンプルなサンプルを、(^^;;;

★１　ファイルチェック＆削除

方法はいくつもありますが、シンプルなのをひとつ。

'----------------------------------------------
Sub test222()

　Dim myFile
　Dim myPath
　Dim Msg

　myPath = ThisWorkbook.Path & "\チェック\*.*"

　myFile = Dir(myPath)

　If myFile = "" Then
　　　MsgBox "ファイルなし", vbOKOnly, "確認"
　Else
　　　Msg = MsgBox("ファイルあり、削除する？", vbYesNo, "確認")
　　　If Msg = vbYes Then
　　　　　Kill myPath
　　　　　MsgBox "全て削除しました", vbOKOnly, "確認"
　　　End If
　End If

End Sub
'-------------------------------------------------

★２　コピー（値のみ）

これまた方法はいくつかありますがシンプルなのをひとつ。

＞編集後の値をBCD列の同じ行にコピー

編集後の「値」、ということですから、
コピー後は、AA,AB,ACとB,C,Dは、ヘッダー、書式を除いて同じ値になるということですね。

'-------------------------------------------------------
Sub Test333()

　Dim R As Long
　Dim LastRow As Long

　LastRow = Cells(Rows.Count, "AA").End(xlUp).Row

　For R = 3 To LastRow
　　　Cells(R, "AA").Value = "1" & Cells(R, "AA").Value
　　　Cells(R, "AC").Value = "30" & Cells(R, "AC").Value
　Next R

　Range("AA3", Cells(LastRow, "AC")).Copy
　Range("B3").PasteSpecial xlPasteValues
　Application.CutCopyMode = False

End Sub
'----------------------------------------------

因みに、書式（色とか罫線とか）もコピーするなら、

＞Range("AA3", Cells(LastRow, "AC")).Copy
＞Range("B3").PasteSpecial xlPasteValues
＞Application.CutCopyMode = False

上記３行は次の１行でＯＫ。

　Range("AA3", Cells(LastRow, "AC")).Copy Range("B3")

以上。

お礼

ありがとうございます！
お陰様で、無事問題解決しました。
目下、別の課題解決に向け悩み中です（汗）

回答No.3

Wendy02

こんにちは。

>以下の２点の作り方がわかりません

#1さんのアドバイスを読んで当初のアップロードをやめて様子をみましたが、#2のonlyromさんのご指摘のとおり、特に、1 のほうは難しいし、一通り、VBAをやったレベルでないと、完成までは到達しないような気がします。

ただ、急がないのであれば、ある程度まで、じっくりと頑張ってみる必要があるような気がします。ひとつのことに、1年ぐらい頑張ってみる気があれば、どんなことでも解決はしていきます。それでは、仕事の役にはなりません。でも、それでもしょうがないというか、一生のものだと思えばよいです。会社のためでも、誰かのためでもなく、自分のために、技術を上げればよいと思うのです。

1.　は、

fol = Dir(MYPATH, vbDirectory)
のように使います。

そして、取れた値(fol)を、もう一度、
GetAttr(MYPATH & fol) And vbDirectory = vbDirectory

にしてチェックしたほうが良いです。

削除は、このようにしてよいです。

Kill MYPATH & fol & "\*.*"　'全ファイル削除
しかし、この方法ですと、強制削除が出来ません。

2. は、初歩的ですが、

"1" & Range("AA3").Value のようなスタイルで良いです。

それを、ループしてあげます。

これらは、標準モジュールへの登録をしてください。

1.

Sub CheckFolders()
　　Dim myPath As String
　　Dim fol As String
　　Dim flg As Boolean
　　Dim fn As String
　　Dim i As Long
　　Dim ret As VbMsgBoxResult
　　Const SUBFOLDER As String = "チェック"

　　myPath = ThisWorkbook.Path & "\"

　　flg = False

　　fol = Dir(myPath, vbDirectory)
　　Do While fol <> ""
　　　　If (GetAttr(myPath & fol) And vbDirectory) = vbDirectory Then
　　　　　　If StrComp(fol, SUBFOLDER, vbTextCompare) = 0 Then
　　　　　　　　flg = True
　　　　　　　　Exit Do
　　　　　　End If
　　　　End If
　　　　fol = Dir()
　　Loop
　　If flg Then
　　　　fn = Dir(myPath & SUBFOLDER & "\")
　　　　If Len(fn) > 0 Then
　　　　　Do While fn <> ""
　　　　　　If (GetAttr(myPath & SUBFOLDER & "\" & fn) And vbNormal) = vbNormal Then
　　　　　　　　i = i + 1
　　　　　　End If
　　　　　　If (GetAttr(myPath & SUBFOLDER & "\" & fn) And vbReadOnly) = vbReadOnly Then
　　　　　　　MsgBox fn & "は、読み取り専用ファイルですので、現在のコードでは削除できません。", vbCritical
　　　　　　　Exit Sub
　　　　　　End If
　　　　　　fn = Dir()
　　　　　Loop
　　　　End If
　　　　If i > 0 Then
　　　　　　ret = MsgBox(myPath & SUBFOLDER & vbCrLf & "の" & i & "個のファイルをすべて削除してよろしいですか？", vbOKCancel, "ファイル削除")
　　　　　　If ret = vbOK Then
　　　　　　　　Kill myPath & SUBFOLDER & "\*.*"　'全ファイル削除
　　　　　　　　MsgBox "削除完了", 64, "終了"
　　　　　　Else
　　　　　　　　MsgBox "中止しました。", 64, "削除中止"
　　　　　　End If
　　　　Else
　　　　　 MsgBox myPath & SUBFOLDER & vbCrLf & "にファイルはありません。", 48, "結果"
　　　　End If
　　Else
　　　　　 MsgBox myPath & SUBFOLDER & vbCrLf & "のフォルダがありません。", 48, "結果"
　　End If
　　Exit Sub
End Sub

2.

Sub TestAddfig()
　　Dim c As Variant
　　Application.ScreenUpdating = False
　　With Range("AA3", Range("AA65536").End(xlUp))
　　　　For Each c In .Cells
　　　　　　c.Value = 1 & c.Value
　　　　　　c.Offset(, 2).Value = 30 & c.Offset(, 2).Value
　　　　Next c
　　 Range("B3").Resize(.Rows.Count, 3).Value = .Resize(, 3).Value
　　End With
　　Application.ScreenUpdating = True
End Sub

お礼

ありがとうございます！
お陰様で、無事問題解決しました。
目下、別の課題解決に向け悩み中です（汗）

回答No.1

hana-hana3

＞ネットで調べても参考になりそうな情報がヒットせず、困っています。

いくらでもあるはずですよ。

[vba フォルダ　有無]
http://search.goo.ne.jp/web.jsp?status=select&from=goo_oshiete&PT=goo_oshiete&nsMT=&MT=vba+%A5%D5%A5%A9%A5%EB%A5%C0%A1%A1%CD%AD%CC%B5&c=0
[vba ファイル名取得]
http://search.goo.ne.jp/web.jsp?status=select&from=goo_oshiete&PT=goo_oshiete&nsMT=&MT=vba+%A5%D5%A5%A1%A5%A4%A5%EB%CC%BE%BC%E8%C6%C0&c=0
[vba ファイル名取得 削除]
http://search.goo.ne.jp/web.jsp?SGT=0&PT=goo_oshiete&from=query&MT=vba+%A5%D5%A5%A1%A5%A4%A5%EB%CC%BE%BC%E8%C6%C0+%BA%EF%BD%FC&DC=100

２．簡単な事ですけど・・・。
Range("B3") = "1" & Range("AA3")
この仕組みをループ文で処理できるように書き換える事です。

[vba 列　最下行取得]
http://search.goo.ne.jp/web.jsp?SGT=0&PT=goo_oshiete&from=query&MT=vba+%CE%F3%A1%A1%BA%C7%B2%BC%B9%D4%BC%E8%C6%C0&DC=100
[ｅｘｃｅｌ　vba 繰り返し文]
http://search.goo.ne.jp/web.jsp?SGT=0&PT=goo_oshiete&from=query&MT=%A3%E5%A3%F8%A3%E3%A3%E5%A3%EC%A1%A1vba+%A1%A1%B7%AB%A4%EA%CA%D6%A4%B7%CA%B8&DC=100

お礼

早速のご回答ありがとうございます。

＞[vba フォルダ　有無]
こちら、上位ヒット５ページぶんくらいを確認したのですが、ちょっと見つかりませんでした。私の確認の仕方が悪いのでしょうか…
確認したいのはフォルダの有無ではなく、特定フォルダ内のファイルの有無（フォルダ内のファイルの数）です。
また、ファイル名の取得は不要です。

２に関してもすみません、ループの仕方は何となく想像がつくので、ネットで探し出せるとは思いますが、セルの番号？（B3など）が固定になっているのが、ちょっと不思議に思っています。