如果使用VBA在Excel中當前行不是空白，則在下面插入行

Question

我目前有一個會員數據庫，通過該數據庫可以為每個會員添加應用程序/付款。 我希望能夠有一個工作表，每個成員具有當前的“申請/付款”表，另一個工作表用於存檔。 一切正常，直到添加新的應用程序/付款，我需要在存檔表中將舊的應用程序/付款詳細信息分配給會員。

我希望代碼檢查（1）存檔中的“成員行”是否為“ A”以外的空白，如果是，則（2）在此處復制信息。 （3）如果不是，則在下面直接插入行並在其中復制信息。

我設法讓（2）工作。 我需要（1）和（3）的幫助。

'Records Sheet is Worksheet where Member Details are entered/edited
Sheets("Records").Select
Dim c As Range
Dim i As Integer
i = 1

'Looks in pre-populated Member ID Range in Archive Sheet
For Each c In Worksheets("Application Archives").Range("MemberID4")
'If a cell in Member ID Range = Member ID, Then Copy Date1 from Records Sheet to Archive Sheet, in same Row as Member ID
If c = Range("Member").Value Then
'Start using Applications Worksheet
Worksheets("Application Archives").Range("B5").Cells(i).Value = Range("App_Date").Value
Worksheets("Application Archives").Range("C5").Cells(i).Value = Range("Exp_Date").Value

End If
i = i + 1
Next c

更新：

我設法使用下面的代碼解決了上面提出的原始問題。 但是，現在，如果存檔表中有2個或兩個以上的成員條目，則在EACH條目下方插入一行。 我最多只希望插入一個行，最好在最后一個條目下方。

If c = Range("Member").Value Then
'Start using Applications
    If IsEmpty(Worksheets("Application Archives").Range("B5").Cells(i).Value) = False Then
    Worksheets("Application Archives").Range("B5").Cells(i).Offset(1, 0).EntireRow.Insert
    Worksheets("Application Archives").Range("B5").Cells(i).Offset(1, -1).Value = Range("Member").Value
    Else

Answer 1

我無法在評論中得到所有這些。 這就是我要做的事情。

'Records Sheet is Worksheet where Member Details are entered/edited
Sheets("Records").Select
Dim c As Range
Dim i As Integer
Dim bFound as Boolean 'Variable to detect whether you've found an entry or not
bFound=False 'Set to False for first iteration through loop
i = 1

'Looks in pre-populated Member ID Range in Archive Sheet
For Each c In Worksheets("Application Archives").Range("MemberID4")
Do While not bFound
'If a cell in Member ID Range = Member ID, Then Copy Date1 from Records Sheet to Archive Sheet, in same Row as Member ID
If c = Range("Member").Value Then
'Start using Applications

If IsEmpty(Worksheets("Application Archives").Range("B5").Cells(i).Value) = False Then
bFound=True ' Set value to True so that the loop exits
Worksheets("Application Archives").Range("B5").Cells(i).Offset(1, 0).EntireRow.Insert
Worksheets("Application Archives").Range("B5").Cells(i).Offset(1, -1).Value = Range("Member").Value

Else

End If
i = i + 1
Loop 
Next c

現在，這只會插入一行，但是會在找到的第一個條目上插入。 我的建議是將For Each c in Worksheets重構For Each c in Worksheets向后迭代，即從下往上迭代，並將bFound檢查合並為一行。 這應該給您一些想法，但是您可以從中開始。