1

わかりましたので、ここで最初の質問に進みます。

SQL を介してデータを取得し、それを特定のテーブルにコピーするシートで作業しています。データには文字列値が含まれています。現在、vbaを使用してデータを取得し(変数が含まれているため)、必要に応じてグリッドにコピーしています。

ここで問題が発生します。データをコピーした後、特定のセル (場合によっては 2 つ、場合によっては 3 つ) をマージする必要があり、これを手動で行います。条件は、C13 = C14 の場合にマージし、C13 と C14 をマージする場合、B13 と B14 もマージし、D13 と D14 もマージする必要があります。次に、マージされたセル (現在は C13) が C15 と等しいかどうかを確認してから、C13 を C15 にマージします。この条件が true の場合、B & D もマージされます。

C13 の条件が真でない場合、つまり C13 <> C14 の場合、次のセル C14 に移動して、C14 = C15 かどうかを確認します。

これをvbaでやりたいのですが、これを手動でやろうとすると、何マイルにもわたるコードが実行されます。誰か助けてください。

これは私がここで見つけたコードの始まりであり、少し変更することができましたが、今は迷っています

Sub Merge()
    Dim k As Range, cell As Range, name As String
    Set k = Range("C13:C50")
    For Each cell In k
        If cell.Value =

        End If
    Next
End Sub
4

2 に答える 2

0

次のコードを提案できます。

Sub Merge()
    Dim k As Range, cell As Range, name As String
    Set k = Range("C13:C50")
    Application.DisplayAlerts = False
Do_it_again:
    For Each cell In k
        If cell.Value = cell.Offset(1, 0).Value _
            And IsEmpty(cell) = False Then
            Debug.Print cell.Address
            'for column C
            Range(cell, cell.Offset(1, 0)).Merge
            'for column B
            cell.Offset(0, -1).Resize(cell.MergeArea.Rows.Count, 1).Merge
            'for column D
            cell.Offset(0, 1).Resize(cell.MergeArea.Rows.Count, 1).Merge
            GoTo Do_it_again
        End If
    Next
    Application.DisplayAlerts = True
End Sub

私が提案したコードのようにする必要はありませんが、結局のところ、以下に示すように機能します。

ここに画像の説明を入力

効率を改善するために編集する 以前のコードは、5000 行以上などの大きなデータ テーブルに対しては効率的ではなかったことを認めなければなりません。以下は 90% 高速ですが、5000 行のデータに対して約 10 ～ 20 秒かかります。

上記のコードと比較した最も重要な変更は、***** でマークされています。

Sub Merge()
    Dim k As Range, cell As Range, name As String
    Dim kStart As Range, kEnd As Range '*****
        Set kStart = Range("C13")      '*****
        Set kEnd = Range("C8000")      '*****

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False       '*****
Do_it_again:
    For Each cell In Range(kStart, kEnd)     '*****
        If cell.Value = cell.Offset(1, 0).Value _
            And IsEmpty(cell) = False Then
            Application.StatusBar = cell.Address  '***** check progress in Excel status bar

            'for column C
            Range(cell, cell.Offset(1, 0)).Merge
            'for column B
            cell.Offset(0, -1).Resize(cell.MergeArea.Rows.Count, 1).Merge
            'for column D
            cell.Offset(0, 1).Resize(cell.MergeArea.Rows.Count, 1).Merge
            Set kStart = cell      '*****
            GoTo Do_it_again
        End If
    Next
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True      '*****
End Sub
于 2013-06-26T21:55:39.220 に答える
0

申し訳ありませんが、count @ 14 を初期化するのを忘れていました

current = cells(13,3)
count = 14
for i = 14 to 15
next = cells(i,3)
If current = next then
    'match encountered, merge columns B,C,D
    for j = 2 to 4
        cells(13,j) = cells(13,j) & cells(count,j)
    next j
    count = count + 1
end if
next i

追加しようとしているのではなく、一致する場合は C13 の値を C14 に置き換え、一致する場合は C13 を C15 に置き換えるなどの場合は、行を変更します。

cells(13,j) = cells(13,j) & cells(count,j)

に

cells(13,j) = cells(count,j)
于 2013-06-26T21:56:35.387 に答える