Excel VBA - 爲什麼我的單元格值不被追加？

Question

我目前有一個腳本（見下文），將所使用的行中每個單元格的內容添加到另一個工作表中的另一個單元格中。但是，這對於前3個單元格是有效的，但由於某些原因不能在最後2個單元格中工作。

Sub Ready_For_Infra() 
Dim i As Integer 
Dim k As Integer 
Dim ws1 As Worksheet 
Dim ws2 As Worksheet 

Set ws1 = Worksheets("InfraData") 
Set ws2 = Worksheets("ActionPlan") 

ws1.Cells.Clear 

For i = 2 To ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row Step 1 
    For k = 1 To ws2.Cells(1, ws2.Columns.Count).End(xlToLeft).Column 
     With Worksheets("InfraData") 
      If ws2.Cells(k, i).Value <> "" Then 
      ws1.Range("A" & i).Value = ws1.Range("A" & i).Value & ws2.Cells(i, k).Value & Chr(10) 
      End If 
     End With 
    Next k 
Next i 

MsgBox "Done" 



End Sub 

這是在WS2中的數據（ActionPlan），以防萬一它有助於：

爲了澄清，它不會出現要追加細胞D2：F3到細胞中我已經要求它。任何人都可以建議爲什麼這可能是這種情況？

Answer 1

試試這個代碼：

Sub Ready_For_Infra() 
    Dim ws1 As Worksheet, ws2 As Worksheet 
    Dim cell As Range 
    Dim i As Long, lastrow As Long, lastcol As Long 
    Dim str1 As String 

    Set ws1 = Worksheets("InfraData") 
    Set ws2 = Worksheets("ActionPlan") 

    ws1.Cells.Clear 

    With ws2 
     lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row 
     lastcol = .Cells(1, .Columns.Count).End(xlToLeft).Column 
     For i = 2 To lastrow 
      str1 = "" 
      For Each cell In .Range(.Cells(i, 1), .Cells(i, lastcol)) 
       If cell.Value <> "" Then str1 = str1 & cell.Value & Chr(10) 
      Next cell 
      ws1.Range("A" & i).Value = str1 
     Next i 
    End With 

    MsgBox "Done" 
End Sub 

注：使用For each循環

1. 稍快則For k=1 To lastcol
2. 使用臨時字符串變量str1使你的代碼也更快，因爲在這種情況下，您只在ws1.Range("A" & i)單元格中寫入結果值一次（使用操作內存總是比每次迭代在單元​​格中寫入子結果的速度更快）。