返回列表 上一主題 發帖

[發問] (已解決)使用自動篩選修改資料

試看看
  1. Sub ex()
  2. Dim Rng As Range
  3. Application.ScreenUpdating = False
  4. Set d = CreateObject("Scripting.Dictionary")
  5. With 工作表2
  6.    For Each a In .Range(.[A2], .[A2].End(xlDown))
  7.       d(a.Value) = a.Offset(, 1).Value
  8.    Next
  9. End With
  10. With 工作表1
  11. If .AutoFilterMode = False Then .Range("A:B").AutoFilter
  12. For Each ky In d.keys
  13.    .Range("A:B").AutoFilter 1, ky
  14.    Set Rng = .AutoFilter.Range.Offset(1, 0).Columns(2).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants)
  15.    If Rng.Count > 0 Then Rng = d(ky)
  16. Next
  17. .Range("A:B").AutoFilter
  18. End With
  19. Application.ScreenUpdating = True
  20. End Sub
複製代碼
回復 1# freeffly
學海無涯_不恥下問

TOP

回復 5# freeffly


    Sub ex()
Dim Rng As Range
Application.ScreenUpdating = False
Set d = CreateObject("Scripting.Dictionary")  '創建一個字典物件
With 工作表2
   For Each a In .Range(.[A2], .[A2].End(xlDown))  '在A2以下儲存格做迴圈
      d(a.Value) = a.Offset(, 1).Value  '以a的值作為索引,a的右側儲存格的值加入字典物件
   Next
End With
With 工作表1
If .AutoFilterMode = False Then .Range("A:B").AutoFilter  '假如工作表非自動篩選狀態,就執行A:B欄資料自動篩選
For Each ky In d.keys  '以字典物件的索引做迴圈
   .Range("A:B").AutoFilter 1, ky    'A:B欄自動篩選,以第一欄(A欄),準則為字典物件索引值做篩選
   Set Rng = .AutoFilter.Range.Offset(1, 0).Columns(2).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants)  '自動篩選範圍向下一列的第2欄中所有可見儲存格並且是非空格的部分賦予變數Rng
   If Rng.Count > 0 Then Rng = d(ky)  '如果Rng這個範圍的儲存格數量大於零,表示有此準則資料,就將這些儲存格填入以ky為索引值的字典內容
Next
.Range("A:B").AutoFilter  '解除自動篩選
End With
Application.ScreenUpdating = True
End Sub
學海無涯_不恥下問

TOP

        靜思自在 : 站在半路,比走到目標更辛苦。
返回列表 上一主題