Question

我目前有一个会员资格数据库，每个会员都可以添加应用程序/付款。我希望能够为每个成员提供一张包含CURRENT申请/付款单的表，另一张用于存档。一切都还可以，直到添加新的申请/付款，我要求现在的旧申请/付款细节在档案表中分配给会员。

我希望代码检查（1）存档中的成员行是否为“A”以外的BLANK，如果是，则（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个或更多条目，则在每个条目下方插入一行。我只希望最多插入一行，最好是在最后一个条目下面。

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向后迭代，即自下而上，并将bFound检查合并为一行。这应该会给你一些想法。

如果当前行在VBA

1 个答案: