0

A と D が一致する場合は、A を G に貼り付けます。次に、B と E を追加し、結果を列 H に配置します。B と E の値を H に追加するのに問題があります。

Private Sub CommandButton1_Click()
    Dim rng1 As Range
    Dim rng2 As Range
    Dim RowNo As Long
    Dim LR As Long

    Set rng1 = Worksheets("Sheet1").Range("D1:D100", Worksheets("Sheet1").Range("D" & Rows.Count).End(xlUp))
    Set rng2 = Worksheets("Sheet1").Range("A1:A100", Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp))

    For Each d In rng1
    LR = Range("H" & Rows.Count).End(xlUp).Row
    Range("F1:F" & LR).Formula = "=H1+C1"
        If Not d.Value = "" And Application.WorksheetFunction.CountIf(rng2, d) > 0 Then
            RowNo = Application.WorksheetFunction.Match(d, rng2)

            If d.Offset(, 1).Value = "" Then d.Offset(, 3).Resize(1).Value _
            = Worksheets("Sheet1").Range("A" & RowNo).Value

            If d.Offset(, 1).Value = "" Then d.Offset(, 4).Resize(1).Value _
            = Worksheets("Sheet1").Range("B" & RowNo).Value
        End If
    Next d
End Sub

セルの例:

A   1           X   22      A 45
B   2           C   33      C 36
C   3           A   44      F 105
D   4           Y   55      
E   5           J   66      
F   6           O   77      
G   7           T   88      
                F   99      
                W   11
4

1 に答える 1

0

問題が正しい数値を H に入れることだけである場合は、このコードを使用してください。「終了サブ」のためだけに置いてください。このコードでは、A と D に 1000 を超える行が入力されることはないと想定していますが、これは変更できます。

Range("H1").Select
ActiveCell.FormulaR1C1 = _
    "=SUMIF(R1C1:R1000C1,RC[-1],R1C2:R1000C2)+SUMIF(R1C4:R1000C4,RC[-1],R1C5:R1000C5)"
Selection.Copy
Range("H2:H" & WorksheetFunction.CountA(Columns(7))).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("H1:H" & WorksheetFunction.CountA(Columns(7))).Select
'the following lines are only necessary if you don't want a formula in H.
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

それが役立つことを願っています! マックス

于 2013-09-11T14:57:43.903 に答える