0

まず第一に、VBAを使い始めている私のような人々にとって非常に役立つこのようなサイトを立ち上げてくれてありがとう。私は自分が行う手作業を自動化しようとしているところですが、これは本当に時間のかかる作業です。plsはこれで私を助けます。要求。以下のとおりです。

X       Y
----    ---
2134    100
2134    200
2134    300
3456    400
3241    500
2516    600
2516    700

上記のように「X」列と「Y」列のシートがあります。これは私のソースシートです。このような値が何千もあり、行は毎日（動的）加算されます。に出力シートがnew workbook>>new sheet必要で、次のような出力が必要です。

X1      Y1
----    ---
2134    100
3456    400
3241    500
2516    600

つまり、列「X」および「Y」の最初のインスタンス。これを自動的に行うためにVBAを取得するのを手伝ってください。何千ものデータを手動で更新する必要があるため、この作業に毎日4時間を費やしています。

前もって感謝します

4

3 に答える 3

1

もう 1 つのオプションは、以下のオプションを使用して [データ] タブから [高度なフィルター] を選択することです。

ここに画像の説明を入力

結果をコピーして新しいシートに貼り付け、フィルターをクリアできるようになりました

于 2012-07-31T09:38:00.897 に答える
1 
Sub Firsts()
    Dim dict As Object, k
    Dim c As Range, tmp
    Dim sht As Worksheet

    Set dict = CreateObject("scripting.dictionary")

    For Each c In ActiveSheet.Range("A1:A10000").Cells
        tmp = c.Value
        If Len(tmp) = 0 Then Exit For
        If Not dict.exists(tmp) Then dict.Add tmp, c.Offset(0, 1).Value
    Next c

    DumpDict Workbooks.Add().Sheets(1).Range("A1"), dict

End Sub


Sub DumpDict(rng As Range, dict As Object)
Dim k, r As Long
    r = 0
    For Each k In dict.keys
        rng.Cells(1).Offset(r, 0).Resize(1, 2).Value = Array(k, dict(k))
        r = r + 1
    Next
End Sub
于 2012-07-30T18:52:36.277 に答える
0

私はこれがあなたが望むものを手に入れると信じています：

Sub copyOver()
    Dim count As Integer
    count = Application.WorksheetFunction.CountA(Range("A:A"))
    Dim rowCount As Integer
    rowCount = 1
    Dim i As Integer
    i = 2
    Do While i <= count
        Dim str As String
        str = Range("A" & i)
        Dim find As String
        On Error GoTo copy:
        find = Application.WorksheetFunction.VLookup(str, Range("A1:A" & (i - 1)), 1, False)
        i = i + 1
    Loop
    Exit Sub
copy:
    If (Range("A" & i) = "") Then
        Resume Next
    End If
    Call copier(Range("A" & i), Range("B" & i), rowCount)
    rowCount = rowCount + 1
    Resume Next
End Sub

Sub copier(str1 As String, str2 As String, rowCount As Integer)
    Worksheets("Sheet2").Range("A" & rowCount) = str1
    Worksheets("Sheet2").Range("B" & rowCount) = str2
End Sub

データが列AとBにあり、行1の下から開始していることを確認してください。これがお役に立てば幸いです。

于 2012-07-30T17:01:56.470 に答える