返回列表 上一主題 發帖

請問不知可否寫程式帶出可用機台

回復 1# Qektyyrwp

  1. Sub nn()
  2. Dim lRow&
  3. Dim vD, vTemp

  4. Set vD = CreateObject("Scripting.Dictionary")

  5. lRow = 2
  6. While Cells(lRow, 1) <> ""
  7.    If Left(Cells(lRow, 3), 4) <> "nona" Then ' 可用才加入
  8.      If vD.exists(CStr(Cells(lRow, 1))) Then
  9.        If vD(CStr(Cells(lRow, 1))) = "" Then
  10.          vD(CStr(Cells(lRow, 1))) = Cells(lRow, 2)
  11.        Else
  12.          vD(CStr(Cells(lRow, 1))) = vD(CStr(Cells(lRow, 1))) & "," & Cells(lRow, 2)
  13.        End If
  14.      Else
  15.        vD(CStr(Cells(lRow, 1))) = Cells(lRow, 2)
  16.      End If
  17.    Else
  18.      vD(CStr(Cells(lRow, 1))) = ""
  19.    End If
  20.    lRow = lRow + 1
  21. Wend

  22. [A16:B50].Clear
  23. lRow = 16
  24. For Each vTemp In vD
  25.    Cells(lRow, 1) = vTemp
  26.    If vD(vTemp) <> "" Then
  27.      Cells(lRow, 2) = vD(vTemp)
  28.    Else
  29.      Cells(lRow, 2) = "無"
  30.    End If
  31.    lRow = lRow + 1
  32. Next
  33. End Sub
複製代碼
寫程式帶出可用機台-a.zip (13.92 KB)

TOP

        靜思自在 : 我們要做好社會的環保,也要做好內心的環保。
返回列表 上一主題