[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『どこが間違いか、ご教示いただけませんか。』（KPO）
Dim folder As String
Dim file As String
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = False Then Exit Sub 'ESCなら中止
folder = .SelectedItems(1) & "\"
End With
file = Dir(folder & "*.csv")
Do While file <> ""
Dim wb As Workbook
Set wb = Workbooks.Open(folder & file)
With wb.Sheets(1)
.Range("D:D,H:H").EntireColumn.Insert Shift:=xlToRight
'ここからが上手く動きません･･･
.Range(Range("C7"), Cells(Rows.Count, 3).End(xlUp)).Copy
.Range("D7").PasteSpecial Paste:=xlPasteAll
.Range("D7").Select
ActiveCell.FormulaR1C1 = "=+RC[-1]*24"
.Range("D7").NumberFormatLocal = "G/標準"
.Range("D7").Select
.Range("D7").AutoFill Destination:=Range(Range("D7"), Cells(Rows.Count, 4).End(xlUp)), Type:=xlFillDefault
End With
wb.Close True
file = Dir
Loop
＜ 使用 Excel：Office365、使用 OS：Windows10 ＞
.Range(Range("C7"), Cells(Rows.Count, 3).End(xlUp)).Copy
↓
.Range(.Range("C7"), .Cells(.Rows.Count, 3).End(xlUp)).Copy
ですかね。
（もこな２） 2022/01/28(金) 18:41
最後の一文も、下記同じようにコンマを入れてみたんですが、やはり同じ状況でした･･･
.Range("D7").AutoFill Destination:=.Range(.Range("D7"), .Cells(.Rows.Count, 4).End(xlUp)), Type:=xlFillDefault
（KPO） 2022/01/28(金) 18:57
■１
VBAの世界では基本的に、ブックやシート、セルなど（オブジェクトといいます）はきちんと明示すれば、いちいち選択したりアクティブにしたりする必要はありません、
また、【標準モジュールで】シートの指定を省略した場合、一部の例外を除きActiveSheetを指定したとみなされるルールです。
このため、エラーの内容が提示されてないので推測にはなりますが、↓のようになってしまい、シートのつじつまが合ってないと推測しました。
wb.Sheets(1).Range(ActiveSheet.Range("C7"), ActiveSheet.Cells(ActiveSheet.Rows.Count, 3).End(xlUp)).Copy
■２
また、質問とは関係ありませんが、提示のコードにはインデントが付いていないように思われますが、インデントを適切につけるようにするとコード全体の把握がしやすくなりご自身のデバッグ作業の効率アップに寄与するとおもいますので、こだわりがなければインデントをつけるようにされたほうがよいとおもいます。
また、オートフィルで書式設定と数式の設定をされていますが、おそらく一括して処理が可能かとおもいます。
■３
以上を踏まえて整理するとこんな感じになります。
気が向いたら【ステップ実行】して研究してみてください。
Sub 始まりも終わりもないマクロ()
Dim folder As String
Dim file As String
Dim 最終行 As Long
Stop 'ブレークポイントの代わり
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = False Then
Exit Sub 'ESCなら中止
Else
folder = .SelectedItems(1) & "\"
End If
End With
file = Dir(folder & "*.csv")
Do While file <> ""
With Workbooks.Open(folder & file).Worksheets(1)
.Range("D:D,H:H").Insert
最終行 = .Cells(.Rows.Count, 3).End(xlUp).Row
'最終行が７行目以降の時だけ処理する
If 最終行 > 6 Then
With .Range("D7:D" & 最終行)
.Offset(, -1).Copy .Cells '←実は数式を設定しちゃうので意味がない（上書きされる）
.Formula = "=C7*24"
.NumberFormatLocal = "G/標準"
End With
End If
.Parent.Close True
End With
file = Dir()
Loop
End Sub
■以下、参考になりそうなサイト
【ステップ実行】 https://www.239-programing.com/excel-vba/basic/basic023.html http://plus1excel.web.fc2.com/learning/l301/t405.html
【ブレークポイント】 https://www.239-programing.com/excel-vba/basic/basic022.html https://www.tipsfound.com/vba/01010
【イミディエイトウィンドウ】 https://www.239-programing.com/excel-vba/basic/basic024.html https://excel-ubara.com/excelvba1/EXCELVBA486.html
【ローカルウィンドウ】 https://excel-ubara.com/excelvba4/EXCEL266.html http://excelvba.pc-users.net/fol8/8_2.html
【インデント】 https://excel-ubara.com/excelvba4/EXCEL_VBA_444.html https://thom.hateblo.jp/entry/2018/02/26/234247 https://kabu-macro.com/detail.php?dir=word&dir2=sa-so&uri=zisage
（もこな２） 2022/01/28(金) 20:13
ご教示ありがとうございます。
うまく処理されることができました。
心から感謝申し上げます。
（KPO） 2022/01/31(月) 13:04
ちなみに、よく考えるとcsvファイルをブックとして開いているわけですから、シートはもとより１つだけになるので↓のように解釈されても問題ないとおもいます。
wb.Sheets(1).Range(ActiveSheet.Range("C7"), ActiveSheet.Cells(ActiveSheet.Rows.Count, 3).End(xlUp)).Copy
（もこな２） 2022/01/31(月) 13:28
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = False Then
Exit Sub 'ESCなら中止
Else
folder = .SelectedItems(1) & "\"
End If
End With
※それで、もう一点、ご教示いただきたいことがございます。
いま、「.NumberFormatLocal = "G/標準"で計算された値が、「12」よりも小さいときに「24」を加算」させるVBAを試作しております。
With .Range("D7:D" & lastrow)
.Offset(, -1).Copy .Cells
.Formula = "=C7*24"
.NumberFormatLocal = "G/標準"
If Range("D7:D" & lastrow).Value < 12 Then
.Formula = "=D7+24"
End If
End With
可能であれば、「.NumberFormatLocal = "G/標準"で計算された値が、「12」よりも小さいときに「24」を加算」させるVBAについても、アドバイスいただければ幸いです。
どうぞよろしくお願いいたします。
（KPO） 2022/01/31(月) 13:47
Sub マクロ()
Dim folder As String
Dim file As String
Dim 最終行 As Long
Stop 'ブレークポイントの代わり
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = False Then
Exit Sub 'ESCなら中止
Else
folder = .SelectedItems(1) & "\"
End If
End With
file = Dir(folder & "*.csv")
Do While file <> ""
With Workbooks.Open(folder & file).Worksheets(1)
.Range("D:D,H:H").Insert
最終行 = .Cells(.Rows.Count, 3).End(xlUp).Row
'最終行が７行目以降の時だけ処理する
If 最終行 > 6 Then
With .Range("D7:D" & 最終行)
.Offset(, -1).Copy .Cells
.Formula = "=C7*24"
.NumberFormatLocal = "G/標準"
End With
End If
.Parent.Close True
End With
file = Dir()
Loop
End Sub
（KPO） 2022/01/31(月) 18:04
.Formula = "=C7*24"
↓
.Formula = "=IF(C7*24<24,C7*24+24,C7*24)"
（もこな２） 2022/01/31(月) 19:06
（LOP） 2022/01/31(月) 19:26
最終行、例えば、B列の最後のセルの「1つ下のセル（Offset(1, 0)）」に平均値を計算させて、それをT列までオートフィルさせる方法をアドバイスいただければ幸いです。
よろしくお願いします。
（KPO） 2022/02/01(火) 18:18
（・・・） 2022/02/01(火) 18:49
（KPO） 2022/02/01(火) 18:54
こんなのでワークしませんか？
＞ .NumberFormatLocal = "G/標準"
.Parent.Cells(最終行 + 1, "B").Resize(, 19).FormulaR1C1 = "=AVERAGE(R7C:R[-1]C)"
＞ End With
（半平太） 2022/02/01(火) 19:20
表示形式は、その列ごとの表示形式を維持したままで、平均値を求めたいのですが、その方法のアドバイスもいただければ幸いです。
どうぞよろしくお願いいたします。
（KPO） 2022/02/01(火) 19:39
そうですか・・、なら書式をコピーすればいいんじゃないですか？
＞ .NumberFormatLocal = "G/標準" ＞ .Parent.Cells(最終行 + 1, "B").Resize(, 19).FormulaR1C1 = "=AVERAGE(R7C:R[-1]C)" ＞ End With
.NumberFormatLocal = "G/標準"
With .Parent
.Cells(最終行 + 1, "B").Resize(, 19).FormulaR1C1 = "=AVERAGE(R7C:R[-1]C)"
.Cells(最終行, "C").Resize(, 18).Copy
.Cells(最終行 + 1, "C").Resize(, 18).PasteSpecial Paste:=xlPasteFormats
End With
End With
（半平太） 2022/02/01(火) 20:01
.Range("A6:U6").Copy _
Destination:=Workbooks("Book1").Sheets("Sheet1").Range("A1")
.Range(.Range("A" & lastrow), .Range("U" & .Cells(.Rows.Count, 21).End(xlUp).Row)).Copy _
Destination:=Workbooks("Book1").Sheets("Sheet1").Range("A" & Cells(.Rows.Count, 1).End(xlUp).Row).Offset(1)
ご教示いただければ幸いです。
どうぞよろしくお願いいたします。
（KPO） 2022/02/09(水) 11:54
どのように「上手く行」かないのでしょうか？
（わからん） 2022/02/09(水) 12:39
次のcsvファイルの最終行のデータが、別シートのコピー先の下に下にコピーされず、上書きされてしまいます。
（KPO） 2022/02/09(水) 13:29
【ステップ実行】 https://www.239-programing.com/excel-vba/basic/basic023.html http://plus1excel.web.fc2.com/learning/l301/t405.html 【ブレークポイント】 https://www.239-programing.com/excel-vba/basic/basic022.html https://www.tipsfound.com/vba/01010 【イミディエイトウィンドウ】 https://www.239-programing.com/excel-vba/basic/basic024.html https://excel-ubara.com/excelvba1/EXCELVBA486.html 【ローカルウィンドウ】 https://excel-ubara.com/excelvba4/EXCEL266.html http://excelvba.pc-users.net/fol8/8_2.html
の提示がありましたが、見ましたか？
上記サイトを参考にまずはご自分でデバッグしましょう。
＞.Range(.Range("A" & lastrow), .Range("U" & .Cells(.Rows.Count, 21).End(xlUp).Row)).Copy _
＞Destination:=Workbooks("Book1").Sheets("Sheet1").Range("A" & Cells(.Rows.Count, >1).End(xlUp).Row).Offset(1)
まずは、イミディエイトウィンドウでそれぞれの範囲指定は正しいかどうか、自分の想定と合っているかどうかを確認しましょう。
（めいぷる） 2022/02/09(水) 13:33
Withステートメントを省略してしまったら、回答者にはそれがなにを見てるのわからないので 正しいか間違ってるかわかりません。
>デバッグをすると問題なく、作業は進むようです。 Activeシートに依存するコードになっているので、 デバッグ中にアクティブシートを手動で切り替えると、 マクロを通して実行したときと変わってしまうので注意が必要です。
２行目の
.Range(.Range("A" & lastrow), .Range("U" & .Cells(.Rows.Count, 21).End(xlUp).Row)).Copy _
Destination:=Workbooks("Book1").Sheets("Sheet1").Range("A" & Cells(.Rows.Count, 1).End(xlUp).Row).Offset(1)
↑このCellsはどのシートのCells？
（´・ω・`） 2022/02/09(水) 14:04
Destination:=Workbooks("Book1").Sheets("Sheet1").Range("A" & Cells(.Rows.Count, 1).End(xlUp).Row).Offset(1)
このCellsは、コピー先のブックのシートの中にあるセルになります。
（KPO） 2022/02/09(水) 14:18
>このCellsは、コピー先のブックのシートの中にあるセルになります。 このコードだけでは、実際にそうなっているか確定しません。 そこに問題が潜んでいるとおもいます。
このコードがシートモジュールに書かれていれば、そのシートのセルです。 このコードが標準モジュールにかかれていたら、アクティブシートのセルです。 このままのでは、コードが実行される時に「コピー先のブックのシート」がアクティブになっている必要があります Cellsの親オブジェクトを指定するのが確実です （´・ω・`） 2022/02/09(水) 14:24
それで「PasteSpecial」と「Destination」は組み合わせることができないのでしょうか？
平均値を計算させて、別のシートに貼り付けるときに、式を外して貼り付けたいと思っています。
ご教示の程、よろしくお願いいたします。
（KPO） 2022/02/09(水) 17:42
.Range(.Range("A" & lastrow), .Range("U" & .Cells(.Rows.Count, 21).End(xlUp).Row)).Copy _
Destination:=Workbooks("Book1").Sheets("Sheet1").Range("A" & Cells(Workbooks("Book1").Sheets("Sheet1").Rows.Count, 1).End(xlUp).Row).Offset(1)
下のように変更して上手く行きました。
.Range(.Range("A" & lastrow), .Range("U" & .Cells(.Rows.Count, 21).End(xlUp).Row)).Copy
Workbooks("Book1").Sheets("Sheet1").Range("A" & Cells(Workbooks("Book1").Sheets("Sheet1").Rows.Count, 1).End(xlUp).Row).Offset(1).PasteSpecial , Paste:=xlPasteValues
（KPO） 2022/02/09(水) 18:31
再度
Workbooks("Book1").Sheets("Sheet1").Range("A" & Cells(Workbooks("Book1").Sheets("Sheet1").Rows.Count, 1).End(xlUp).Row).Offset(1).PasteSpecial , Paste:=xlPasteValues
↑
このCellsはどのシートのセルですか？
正しく動作してるっていうなら何もいいませんが、ホントですか？
Workbooks("Book1").Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial
でいいと思いますが
（´・ω・`） 2022/02/09(水) 20:39
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.