Q&A
コードだけからではやりたいことが把握しづらいので、転記元と転記先のシートの画像を提示してもらえますか。
※やりたいこと エクセル VBA
大量の請求書のPDFをエクセルに変換し、そこから数値を拾っています。
そのうち、製造数の項目自体がないものがあります。その場合は、-の記号を入れたいです。
※質問
以下を作成しました。しかし、製造数が項目としてないものに-が入らず、繰り上がって他の請求書の
数値が入力されてしまい他の行とずれているようです。
Dim Rng6 As Range
Set Rng6 = Cells.Find(What:="製造数", LookIn:=xlValues, LookAt:=xlWhole)
Dim mystr1f, mystr2f, mystr3f, mystr4f
mystr1f = Rng6.Row mystr4f = Rng6.Column mystr3f = Cells(mystr1f, mystr4f).End(xlDown).Row
If Not Rng6 Is Nothing Then
Dim s7 '// セル値 Dim r7 As Range '// 対象セルのRangeオブジェクト '// 空セルまでループ For Each r7 In Range(Cells(mystr1f + 1, mystr4f), Cells(mystr3f, mystr4f)) '// セル値を取得 s7 = r7.Row mystr2f = Cells(s7, mystr4f).Value
Dim i77
i77 = ThisWorkbook.Worksheets(1).Cells(Rows.Count, 7).End(xlUp).Row
ThisWorkbook.Worksheets(1).Cells(i77 + 1, 7) = mystr2f
Next
Else
Dim i79, i78
i79 = ThisWorkbook.Worksheets(1).Cells(Rows.Count, 7).End(xlUp).Row
i78 = ThisWorkbook.Worksheets(1).Cells(Rows.Count, 5).End(xlUp).Row
ThisWorkbook.Worksheets(1).Range(Cells(i79 + 1, 7), Cells(i78, 7)) = "-" Debug.Print mystr1f Debug.Print i79 Debug.Print i78 End If
ご返信ありがとうございます！一応自己解決してしまったので、記載しておきます。
お立ちよりありがとうございました！
Dim Rng6 As Range
Set Rng6 = Cells.Find(What:="製造数", LookIn:=xlValues, LookAt:=xlWhole)
If Rng6 Is Nothing Then
mystr1b = Rng2.Row
mystr4b = Rng2.Column
mystr3b = Cells(mystr1b, mystr4b).End(xlDown).Row
'// 空セルまでループ
For Each rrr In Range(Cells(mystr1b + 1, mystr4b), Cells(mystr3b, mystr4b))
'// セル値を取得
sss = rrr.Row
'// セル値が未設定の場合
If sss = "" Then
'// ループを抜ける
Exit For
End If
iii = ThisWorkbook.Worksheets(1).Cells(Rows.Count, 5).End(xlUp).Row
ThisWorkbook.Worksheets(1).Cells(iii, 7) = "-"
Next
End If
If Not Rng6 Is Nothing Then
Dim mystr1f, mystr2f, mystr3f, mystr4f
mystr1f = Rng6.Row
Debug.Print mystr1f
mystr4f = Rng6.Column
mystr3f = Cells(mystr1f, mystr4f).End(xlDown).Row
Dim s7 '// セル値
Dim r7 As Range '// 対象セルのRangeオブジェクト
'// 空セルまでループ
For Each r7 In Range(Cells(mystr1f + 1, mystr4f), Cells(mystr3f, mystr4f))
'// セル値を取得
s7 = r7.Row
'// セル値が未設定の場合
If s7 = "" Then
Exit For
End If
mystr2f = Cells(s7, mystr4f).Value
Dim i77
i77 = ThisWorkbook.Worksheets(1).Cells(Rows.Count, 7).End(xlUp).Row
ThisWorkbook.Worksheets(1).Cells(i77 + 1, 7) = mystr2f
Next
End If
回答2件
0
自己解決
Dim Rng6 As Range
Set Rng6 = Cells.Find(What:="製造数", LookIn:=xlValues, LookAt:=xlWhole)
If Rng6 Is Nothing Then
mystr1b = Rng2.Row mystr4b = Rng2.Column mystr3b = Cells(mystr1b, mystr4b).End(xlDown).Row '// 空セルまでループ For Each rrr In Range(Cells(mystr1b + 1, mystr4b), Cells(mystr3b, mystr4b)) '// セル値を取得 sss = rrr.Row '// セル値が未設定の場合 If sss = "" Then '// ループを抜ける Exit For End If iii = ThisWorkbook.Worksheets(1).Cells(Rows.Count, 5).End(xlUp).Row ThisWorkbook.Worksheets(1).Cells(iii, 7) = "-" Next
End If
If Not Rng6 Is Nothing Then
Dim mystr1f, mystr2f, mystr3f, mystr4f mystr1f = Rng6.Row Debug.Print mystr1f mystr4f = Rng6.Column mystr3f = Cells(mystr1f, mystr4f).End(xlDown).Row Dim s7 '// セル値 Dim r7 As Range '// 対象セルのRangeオブジェクト '// 空セルまでループ For Each r7 In Range(Cells(mystr1f + 1, mystr4f), Cells(mystr3f, mystr4f)) '// セル値を取得 s7 = r7.Row '// セル値が未設定の場合 If s7 = "" Then Exit For End If mystr2f = Cells(s7, mystr4f).Value Dim i77
i77 = ThisWorkbook.Worksheets(1).Cells(Rows.Count, 7).End(xlUp).Row
ThisWorkbook.Worksheets(1).Cells(i77 + 1, 7) = mystr2f
Next End If
投稿2021/05/10 22:08
総合スコア1
0
If 文とFor Eachの位置関係がおかしいのだと思います。
本来は「For Eachループを回して、空白が見つかったら"-"を入力する」というものを想定していると思いますが、今のコードでは、「シートに"製造数"というセルがあればFor Eachループを回して全ての値を入力する。"製造数"がなければ"-"を入力する」という動きになっています。
結果For Eachループ内で空白にあたったときに何も入力されず、そのままズレていっているのだと思います。
細かくは割愛していますが、本来は以下のようになるのではないでしょうか？
If Rng6 Is Nothing Then Exit Sub '製造数が存在しなければ、処理を終える For Each r7 In Range(Cells(mystr1f + 1, mystr4f), Cells(mystr3f, mystr4f)) If r7 = "製造数" Then 値を入力 Else "-"を入力 End If Next
投稿2021/05/10 08:30
総合スコア364
すみません。質問内容を読み違えているようなので、削除リクエスト中です。
If Rng6 Is Nothing Then Exit Sub '製造数が存在しなければ、処理を終える だとちょっとこまっちゃうんですよね。。回答ありがとうございます。
あなたの回答
tips
プレビュー
