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"), _
どなたかご教授の方お願い致します。
お礼
有難うございます 〉複数領域のセル範囲を扱うなら、 〉 range.Areas プロパティ 〉 range.Intersect メソッド OfficeTanaka 氏の 掲載を、初め 様々な、掲示を 拝見させて、頂いて おりましたが 此等を 目に、するのは 初めての、事 お陰で 光明を、得た と、思えます 重ねて、申します 有り難うございます 〉質問タイトルにある付番に反応しての 今まで 幾度と、なく 質問させて 頂く、中で お礼欄、にて 詳細を お伺い、する 余り 多段に、渡る 質疑応答を お付き合い、 頂く、事も 多く、なって おりました しかし、 此れは、良くない と、反省し テーマ内で 別途、新たに 発起した、質問は 別で、聞くもの と 改めました 此れを、受け ご回答、頂く方 への、配慮 と、して テーマの、連続性 詰まりは、 あぁ、あの続きか と 容易に、想起 頂く、事が 一助に、なれば と、 今回は 未来を、想定し 付けさせて、頂いた 振り番、です 他意は、ありません ので ご容赦、下さい