VBA 検索するSheetの位置の変更
現在、グループの数だけユーザー名の合計数をSheet2に抽出するという
事をやっているのですが.......
コードの方は下記になります
Sub Sample3()
Dim i As Long, j As Long, k As Long, lastRow As Long, lastCol As Long
Dim wS2 As Worksheet, wS3 As Worksheet
Set wS2 = Worksheets("Sheet1")
Set wS3 = Worksheets("Sheet2")
Application.ScreenUpdating = False
If wS2.Range("Y1") = "" Then
wS2.Range("Y1") = "ダミー"
End If
With Worksheets("Sheet1")
If .Range("A4") = "" Then
.Range("A4") = "ダミー"
End If
lastRow = .Cells(Rows.Count, "B").End(xlUp).Row
Range(.Cells(5, "B"), .Cells(lastRow, "B")).AdvancedFilter Action:=xlFilterCopy, copytorange:=wS3.Range("A1"), unique:=True '★
For i = 2 To wS3.Cells(Rows.Count, "A").End(xlUp).Row
wS2.Cells(7, (i - 2) * 8 + 3) = wS3.Cells(i, "A")
.Range("A4").AutoFilter field:=2, Criteria1:=wS3.Cells(i, "A")
Range(.Cells(5, "AA"), .Cells(lastRow, "AA")).SpecialCells(xlCellTypeVisible).Copy wS2.Cells(7, (i - 2) * 8 + 2)
For k = wS2.Cells(Rows.Count, (i - 2) * 8 + 2).End(xlUp).Row To 7 Step -1
wS2.Cells(k, (i - 2) * 8 + 3) = WorksheetFunction.CountIfs(.Range("AA:AA"), wS2.Cells(k, (i - 2) * 8 + 2), .Range("B:B"), _
wS2.Cells(7, (i - 2) * 8 + 3))
If WorksheetFunction.CountIf(wS2.Columns((i - 2) * 8 + 2), wS2.Cells(k, (i - 2) * 8 + 2)) > 1 Then
wS2.Cells(k, (i - 2) * 8 + 2).Resize(, 2).Delete shift:=xlUp
End If
Next k
Next i
wS2.Range("B1").CurrentRegion.Borders.LineStyle = xlContinuous
wS2.Cells.Replace what:="ダミー", replacement:="", lookat:=xlWhole
.Cells.Replace what:="ダミー", replacement:="", lookat:=xlWhole
wS3.Cells.Clear
.AutoFilterMode = False
End With
Application.ScreenUpdating = True
End Sub
このコードで検索をかけるSheet1のセルBの文字をセルCに移動して検索かけたいという事なのですが、下記の用なコードでBをCに変更してみた結果エラーが発生してしまいます。
lastRow = .Cells(Rows.Count, "C").End(xlUp).Row
Range(.Cells(5, "C"), .Cells(lastRow, "C")).AdvancedFilter Action:=xlFilterCopy, copytorange:=wS3.Range("A1"), unique:=True '★
For i = 2 To wS3.Cells(Rows.Count, "A").End(xlUp).Row
wS2.Cells(7, (i - 2) * 8 + 3) = wS3.Cells(i, "A")
.Range("A4").AutoFilter field:=2, Criteria1:=wS3.Cells(i, "A")
Range(.Cells(5, "AA"), .Cells(lastRow, "AA")).SpecialCells(xlCellTypeVisible).Copy wS2.Cells(7, (i - 2) * 8 + 2)
For k = wS2.Cells(Rows.Count, (i - 2) * 8 + 2).End(xlUp).Row To 7 Step -1
wS2.Cells(k, (i - 2) * 8 + 3) = WorksheetFunction.CountIfs(.Range("AA:AA"), wS2.Cells(k, (i - 2) * 8 + 2), .Range("C:C"), _
どなたかご教授の方お願い致します。
お礼
ご教示ありがとうございます。 重複データなしのデータを抽出するためadvancedfilterを実行する際にCriteriaを指定しないでコードを実行するとVBAが自動的にシート上のセルにCriteriaという名前をつけており、そのCriteriaが残ることが問題なことが分かりました。 このCriteriaという名前を削除するコードを加えたところ、正常に機能するようになりました。 このCriteriaという名前が自動的に作成される現象については、別に質問をしてみたいと思っています。