エクセルVBAの修正をお願いいたします。
下記VBAをご教授受けて何とか作りましたが、一行指定で作成したのですが、その時によりデータ数にばらつきがありますので、現状データがあるセルだけを拾ってきてデータのあるなしを、JのセルとKのセルに2種類表示するように作成したつもりですが、データがないセルにも延々と
Jのセルには 1040272
Kのセルには *
が表示されますのでデータが現状ないセルには何も表示されないようにしたいと思います。
自分でいろいろ調べながらしてみるのですが埒が明かない状態になっておりますので、なにとぞお助け、ご教授をお願いいたします。
わかりにくい説明で申し訳ございませんがなにとぞよろしくお願いいたします。
Range("H2").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-5],RC[-4])"
Selection.AutoFill Destination:=Range("H2:H10000")
Range("H2:H10000").Select
Columns("H:H").Select
Selection.Copy
Columns("I:I").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Replace what:="-", Replacement:="", lookat:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace what:="_", Replacement:="", lookat:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Sheets("登録商品リスト").Select
Columns("C:C").Select
Application.CutCopyMode = False
Selection.Copy
Columns("E:E").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Replace what:="_", Replacement:="", lookat:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace what:="-", Replacement:="", lookat:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("F2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=UPPER(RC[-1])"
Selection.AutoFill Destination:=Range("F2:F10000")
Range("F:F").Select
Columns("F:F").Select
Selection.Copy
Columns("G:G").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet2").Select
Range("J2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=COUNTIFS(登録商品リスト!C[-3],C[-1])"
Selection.AutoFill Destination:=Range("J2:J1500")
Range("J:J").Select
Dim i As Long, endRow As Long, str As String, c As Range, wS1 As Worksheet, wS2 As Worksheet
Set wS1 = Worksheets("登録商品リスト")
Set wS2 = Worksheets("Sheet2")
endRow = wS2.Cells(Rows.Count, "K").End(xlUp).Row
Application.ScreenUpdating = False
If endRow > 1 Then
Range(wS2.Cells(2, "K"), wS2.Cells(endRow, "K")).ClearContents
End If
For i = 2 To wS2.Cells(Rows.Count, "I").End(xlUp).Row
str = Left(wS2.Cells(i, "I"), 5)
Set c = wS1.Range("G:G").Find(what:=str, LookIn:=xlValues, lookat:=xlPart)
If Not c Is Nothing Then
wS2.Cells(i, "K") = "*"
End If
Next i
Application.ScreenUpdating = True
End Sub
補足
ご解答ありがとうございます。 汎用性ですが、店頭で出す広告に使用します。 今回広告のレイアウトを全面的に変える事になり、一枚一枚直していては莫大な時間がかかるので、何か方法はないかと考えました。 店頭で出している広告は常時３０枚くらいあります。 そしてＰＣに保存してある広告と定期的に入替えます。 ＰＣに保存してある広告は1000枚以上はあり、今後全て新レイアウトに変更します。 マクロで一括変更できる箇所はしたいと考えました。 現状のコードだと、BOOK名が特定されてしまうので、違うBOOKにはマクロが適用されませんでした。 他のBOOKを開いた時も、現在保存してあるマクロコードが適用されるようにしたいと考えております。 ご解答頂いた内容で不明点がございます。 ネットで変数を調べましたが理解できませんでした。 教えて頂けると助かります。 （１）"ここの部分です.xls"を格納する変数の宣言方法。 （２）この行の"ここの部分です.xls"を変数に置き換える方法。 どうぞ宜しくお願い致します。