返回列表 上一主題 發帖

[發問] 求助填入專案編號

回復 2# xandertco
  1. Sub 填入()
  2. Set d = CreateObject("Scripting.Dictionary")
  3. With Sheets("專案編號")
  4.    ar = .Range("A1").CurrentRegion.Value
  5.    For i = 2 To UBound(ar, 1)
  6.       d(ar(i, 1)) = IIf(d(ar(i, 1)) = "", ar(i, 2), d(ar(i, 1)) & "," & ar(i, 2))
  7.    Next
  8. End With
  9. With Sheets("生產領退料明細表")
  10.    For Each a In .Range("A:A").SpecialCells(xlCellTypeConstants)
  11.    If d(a.Value) <> "" Then
  12.       ay = Split(d(a.Value), ",")
  13.        a.Offset(, 16).Resize(, UBound(ay) + 1) = ay
  14.     End If
  15.    Next
  16. End With
  17. End Sub
複製代碼
學海無涯_不恥下問

TOP

        靜思自在 : 人的心地是一畦田,土地沒有播下好種子,也長不出好的果實。 -
返回列表 上一主題