查找多個值，串聯cooresponding在其他列中的值，寫入到小區

沒有被寫入到細胞在柱P的系的細胞（X，「P」）值= failingClasses應該這樣做。

說明：（以下VBA腳本）

我有ID號的列。每個ID號碼可以有多行。我需要做的是連接另一列中的所有對應值並將其寫入原始行中的單元格中。這需要爲工作表中的每一行完成。

字段1是其中的ID是，現場6是我想連接的信息，我想寫串聯成列P.

現在，我認爲計算是是正確完成，但由於什麼原因它不寫入P中的單元？

宏需要永遠運行。運行時在1k和2k行之間。

謝謝！

Worksheets("RAW GRADE DATA").Select 
    ' Turn off auto calc update and screen update -- saves speed 

    Application.Calculation = xlCalculationManual 
    Application.ScreenUpdating = False 


    Dim x As Long, y As Long, totalGradeEntries As Long, failingClasses As String, failingClassesCell As Excel.Range 

    totalGradeEntries = Cells(Rows.Count, 1).End(xlUp).Row 
    For x = totalGradeEntries To 1 Step -1 

     failingClasses = "" 

     For y = totalGradeEntries To 1 Step -1 

      If Cells(y, 1).Value = Cells(x, 1).Value And Cells(x, 6) <> "02HR" Then 
       failingClasses = failingClasses & " " & Cells(y, 1).Value 
      End If 

      Cells(x, "P").Value = failingClasses 
     Next y 
    Next x 

    ' Turn calc and screen update back on 

    Application.Calculation = xlCalculationAutomatic 
    Application.ScreenUpdating = True

來源

2014-10-31 Devin McGhee

雙循環是什麼殺死速度。這些ID總是連續的（排序）還是無序？（即無序123,155,123,143 ... 123由其他ID分隔） – 2014-10-31 20:04:45

1.在單元格（x，「P」）上放置一個斷點。值=行，並查看當時發生故障的類別。 2.只寫入單元格（x，「P」）一次 - 現在你正在寫每個內部循環。 3.要顯着提高速度，請在VBA陣列中執行「工作」，而不是在工作表上。 – 2014-10-31 20:13:49

波特蘭亞軍 - 我知道雙迴路正在殺死速度。這些ID是無序的，但我可以在循環運行之前做一個排序來解決這個問題。每個ID最多有9個條目。這可以幫助加速嗎？ – 2014-10-31 20:29:39

我得到了一個解決方案，這項工作的骨骼，由於羅恩·羅森菲爾德 - 下面是代碼，在測試表數據的3列工作，唯一ID列是1

Sub CalcArrary() 

    'Declare variables 
    Dim numRows As Integer, calcArray() As Variant 

    'Set the number of rows in the sheet 
    numRows = ActiveSheet.Range("A1").Offset(Sheet1.Rows.Count - 1, 0).End(xlUp).Row 

    ReDim calcArray(numRows - 1, 4) 

    For i = 0 To numRows - 2 
     calcArray(i, 1) = Range("A" & i + 2) 
     calcArray(i, 2) = Range("B" & i + 2) 
     calcArray(i, 3) = Range("C" & i + 2) 
    Next i 

    For b = 0 To numRows - 2 

     For c = 0 To numRows - 2 

      If calcArray(c, 1) = calcArray(b, 1) And calcArray(c, 3) < 60 Then 

       calcArray(b, 4) = calcArray(b, 4) & calcArray(c, 2) & ", " & calcArray(c, 3) & "%  " 

      End If 

     Next c 
    Next b 

    For d = 0 To numRows - 2 

     ActiveSheet.Range("D" & d + 2) = calcArray(d, 4) 

    Next d 

End Sub

來源

2014-11-04 17:38:15

剛剛在我的實際數據上運行真人版---羅恩羅森菲爾德，非常感謝你。從60分鐘執行到〜6秒。從字面上看。 – 2014-11-04 17:58:31

查找多個值，串聯cooresponding在其他列中的值，寫入到小區

回答

相關問題