エクセル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
お礼
OKWAVEのビギナーなもので、ここにお礼が書けるとは知りませんでした。助かりました。ありがとうございます。まだVBAを勉強し始めたものです。本屋に行っても、基本ばかり書かれている本は山のようにありますが、イザこの機能はどうやって、となると殆ど役に立ちません。 そんなわけで、こんな機能はどうやって組むのか、と自問自答とコピペを繰り返しながら試行錯誤の毎日です。またネットで見かけたら質問に答えてやってください。よろしくお願いします。