循環遍歷worhsheet excel vba並在另一個工作表上返回數據

Question

Sub CreateTableD() 

Dim WB As Workbook 
Dim WS1 As Worksheet 
Dim WS2 As Worksheet 
Dim i As Long 
Dim k As Long 
'Dim n As Long 

Set WB = Excel.ActiveWorkbook 
Set WS1 = WB.Worksheets("List1") 
Set WS2 = WB.Worksheets("List2") 

i = 1 
k = 1 
'While Not IsEmpty(WS1.Cells(i, 1)) 
Do While WS1.Cells(i, 1).Value <> "" 
    If (WS1.Cells(i, 4).Value = "Depo" And WS1.Cells(i, 8).Value = "CZK") Then 
     WS2.Cells(k + 1, 4).Value = WS1.Cells(i, 7).Value 
     WS2.Cells(k + 2, 4).Value = WS1.Cells(i, 7).Value 
     WS2.Cells(k + 1, 7).Value = "79010000" 
     WS2.Cells(k + 2, 7).Value = "79010000" 




     ElseIf (WS1.Cells(i, 4).Value = "Loan" And WS1.Cells(i, 8).Value = "CZK") Then 

     WS2.Cells(k + 1, 4).Value = WS1.Cells(i, 7).Value 
     WS2.Cells(k + 2, 4).Value = WS1.Cells(i, 7).Value 
     WS2.Cells(k + 1, 7).Value = "75010000" 
     WS2.Cells(k + 2, 7).Value = "75010000" 


     k = k + 2 
    End If 
    i = i + 1 
'Wend 
Loop 



Range("D1").Select 
     ActiveCell.FormulaR1C1 = "CZK" 
End Sub 

嗨。我有一個代碼，但它不能正常工作。如果滿足兩個條件，它必須返回另一個工作表上的利息，還有一些靜態數據（在代碼中），我已經在第二張圖片上顯示了正確的結果。

first worksheet with conditions

on this picture i showed what i need to get

Answer 1

的問題是，你只遞增k當它是一個貸款。

If (WS1.Cells(i, 4).Value = "Depo" And WS1.Cells(i, 8).Value = "CZK") Then 

ElseIf (WS1.Cells(i, 4).Value = "Loan" And WS1.Cells(i, 8).Value = "CZK") Then 
    k = k + 2 
End If 

遞增k當eith條件爲真時將解決問題。

If (WS1.Cells(i, 4).Value = "Depo" And WS1.Cells(i, 8).Value = "CZK") Then 
    k = k + 2 
ElseIf (WS1.Cells(i, 4).Value = "Loan" And WS1.Cells(i, 8).Value = "CZK") Then 
    k = k + 2 
End If 

我通常創建一個單獨的函數來處理向表中添加數據。將代碼分解成更小的單元有助於簡化調試。

下面是我將如何寫它。

Sub CreateTableD() 
    Dim x As Long 

    With Worksheets("List1") 
     For x = 2 To .Range("D" & .Rows.Count).End(xlUp).Row 
      If .Cells(x, 8).Value = "CZK" Then 
       If .Cells(x, 4).Value = "Depo" Then 
        AddList2Entry .Cells(x, 7).Value, "79010000" 
        AddList2Entry .Cells(x, 7).Value, "79010000" 
       ElseIf .Cells(x, 4).Value = "Loan" Then 
        AddList2Entry .Cells(x, 7).Value, "75010000" 
        AddList2Entry .Cells(x, 7).Value, "75010000" 
       End If 
      End If 
     Next 
    End With 

End Sub 

Sub AddList2Entry(interest As Double, StaticValue As Double) 
    Dim newRow As Long 
    With Worksheets("List2") 
     newRow = .Range("D" & .Rows.Count).End(xlUp).Row + 1 
     .Cells(newRow, "D").Value = interest 
     .Cells(newRow, "G").Value = StaticValue 
    End With 
End Sub