返回列表 上一主題 發帖

[發問] 輸入至不同欄位儲存格來個別找出兩個工作表對應值

回復 3# luke

一般模組
  1. Public Dic As Object
  2. Sub Auto_Open()
  3. Dim Sht(), A As Range
  4. Set Dic = CreateObject("Scripting.Dictionary")
  5. Sht = Array("Sheet2", "Sheet3")
  6. For Each sh In Sht
  7.    With Worksheets(sh)
  8.       For Each A In .Range(.[A1], .[A1].End(xlDown))
  9.          Select Case sh
  10.          Case "Sheet2"
  11.          Dic(A.Value) = Array(A.Offset(, 1).Value, A.Offset(, 2).Value)
  12.          Case "Sheet3"
  13.          Dic(A.Value) = Array(A.Offset(, 1).Value, A.Offset(, 2).Value, A.Offset(, 3).Value)
  14.          End Select
  15.         Next
  16.     End With
  17. Next
  18. End Sub
複製代碼
Sheet1模組
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2. If Target.Count > 1 Then Exit Sub
  3. If IsEmpty(Dic(Target.Value)) Or Target.Count > 1 Then Exit Sub
  4. s = IIf(Target.Column = 1, 2, IIf(Target.Column = 4, 3, 0))
  5. k = UBound(Dic(Target.Value)) + 1
  6. If s <> k Then Exit Sub
  7. Application.EnableEvents = False
  8. Target.Offset(, 1).Resize(, k).Value = Dic(Target.Value)
  9. Application.EnableEvents = True
  10. End Sub
複製代碼
存檔後關閉再重新開啟檔案
學海無涯_不恥下問

TOP

        靜思自在 : 有心就有福,有願就有力,自造福田,自得福緣。
返回列表 上一主題