A.xlsmというファイルに下記のような、CSVを開いて1行ずつチェックし、A.xlsmに条件に合う行をコピー&ペーストし、条件に合わない場合はA.xlsmの空白になる1行を削除するプログラムを書いています(プロシージャの中の抜粋です)。
A.xlsmのWSというワークシートの1行目には、画像のようにデータの見出しを記述しており、J1にも元々はコード2という見出しをつけているのですが、マクロを実行すると画像のようにコード2という名前がhahaha24というコードの中身に書き換わってしまい困惑しています。
ステップ実行をしてみたところ、
ws.Cells(firstLine + 1).Rows.Delete
が最初に実行されたときJの列のデータが1行上にずれていることは分かったのですがなぜその列だけがずれるのかが分かりません。
解決方法、ご教示よろしくお願い致します。
VBA
1Dim ws As Worksheet 2Set ws = Workbooks("A.xlsm").Worksheets("WS") 3Dim copyI As Long 4copyI = 2 5Dim count As Long 6count = 0 7Dim firstLine As Long 8Dim varFileName As Variant 9'↓補足に書きました誤記修正しました 10Dim ws2 As WorksheetSet 11Set ws2 = ThisWorkbook.Worksheets(1) 12'↑補足に書きました誤記修正しました 13varFileName = dCsv 14If varFileName = False Then 15Exit Sub 16End If 17Workbooks.Open Filename:=varFileName 18 19firstLine = ws.Cells(Rows.count, "A").End(xlUp).Row 20 21DoEvents 22With CreateObject("VBScript.RegExp") 23.Pattern = "aaa|bbb|ccc|" 24Do While ActiveWorkbook.Worksheets(1).Cells(copyI, 1).Value <> "" 25 26Dim Rng As Range 27 28Set Rng = ws.Columns(1).Find(What:=ActiveWorkbook.Worksheets(1).Cells(copyI, 1).Value, LookIn:=xlValues, LookAt:=xlWhole) 29If Rng Is Nothing _ 30And ActiveWorkbook.Worksheets(1).Cells(copyI, 1).Value = 1 _ 31And ActiveWorkbook.Worksheets(1).Cells(copyI, 2).Value = "Yes" _ 32And ActiveWorkbook.Worksheets(1).Cells(copyI, 3).Value = "Yes" _ 33And ActiveWorkbook.Worksheets(1).Cells(copyI, 4).Value = "Yes" _ 34And Not .test(ActiveWorkbook.Worksheets(1).Cells(copyI, 5)) _ 35And Not .test(ActiveWorkbook.Worksheets(1).Cells(copyI, 7)) Then 36ActiveWorkbook.Worksheets(1).Rows(copyI).Copy 37ws.Rows(firstLine + 1 - count).PasteSpecial (xlPasteAll) 38Else 39ws.Cells(firstLine + 1).Rows.Delete 40count = count + 1 41End If 42copyI = copyI + 1 43firstLine = firstLine + 1 44Loop 45End With 46Application.ScreenUpdating = True
今回のA.xlsmの対象シートの関連性を教えてください
Workbooks("A.xlsm").Worksheets("WS")
ThisWorkbook.Worksheets(1)
ActiveWorkbook.Worksheets(1)
書き方は別ですが同じシートを見ている可能性があります
ActiveWorkbook.Sheets("WS")
等記載を合わせたほうが良いかと思います。
コードは「コードの挿入」で記入してください。
デバッグはされましたか? ステップ実行して不具合の原因を確かめる事が出来ます。
Dim ws As WorksheetSet ws = ThisWorkbook.Worksheets(1)
は
Dim ws2 As Worksheet
Set ws2 = ThisWorkbook.Worksheets(1)
の間違いです・・、すみません・・。
>>kuma_kuma_
ActiveWorkbook.Worksheets(1)のセルを
Workbooks("A.xlsm").Worksheets("WS")にコピーしたいと思っています。
>> meg_
すみません、「コードの挿入」で書き換えました。
全体的なデバッグはデバッグのウインドウがでなかったのでしていません。
ステップ実行は今知りました。
調べながらやってみます。
Set ws = Workbooks("A.xlsm").Worksheets("WS")
Set ws2 = ThisWorkbook.Worksheets(1)
この後
debug.print ws.name
debug.print ws2.name
debug.print ws.Parent.name
debug.print ws2.Parent.name
してみて下さい。ちゃんと目的のシートが選ばれていますか?
>> kuma_kuma_
ありがとうございます。
やってみたのですが何も起こりませんでした。
?シートとファイルの名前イミディエイトウィンドウに表示されていない?
https://tonari-it.com/excel-vba-debug-print/
https://www.239-programing.com/excel-vba/basic/basic024.html
ステップ実行をしてみたところ、
ifのところでtrueの時には正常にコピーペースト出来ているのですが、
falseの時、
count = count + 1
が黄色くなった時にJ1が書き換わりました。
その後もfalseのたびに1行目の、前に書き換わった列の右の列の値が書き換わっています。
Set ws = Workbooks("A.xlsm").Worksheets("WS")
Set ws2 = ThisWorkbook.Worksheets(1)
ActiveWorkbook.Worksheets(1)
まだ記載方法3種類で残っていますよ。
すみません、イミディエイトウインドウが非表示になっていました。
実行してみたところ、想定通りのbook,sheetが出力されました。
コードの実行したところ、
falseの時に、
count = count + 1
が黄色くなった時に、Jの列全体が1行上にずれているようです。
ActiveWorkbook.Worksheets(1)の記載を
ws か ws2 に変更して下さい
あと
ws.Cells(firstLine + 1).Rows.Delete
行が削除される
'count = count + 1 'ここは要らない 1行移動する必要なし
count = count + 1を消すと条件がfalseの時にペースト先のシートに空白の行が出来てしまい、この後、ペーストしたデータをすべて使った処理をする時に支障が出てしまいます・・。
count = count + 1を消してみたのですがJの列は1行上にずれてしまいます。
回答1件
あなたの回答
tips
プレビュー