0

この問題は、Excelの.xlsファイルにあります。

最も単純なユースケース：

列Aには1つの行があります。列Bには5行あります。列Bの5行は、改行で区切られた1つの行にマージする必要があります。

列Aに大量のIDがある巨大な.xlsドキュメントがあります。各列Aの行に属する行は平均して3〜10行あります。

どの列Bの行がどの列Aに属しているかを知る方法は？セルの配置によって。1つの列Aの行には、その右側に5つの列Bの行がある場合があります。

VBAの経験はありません。私はマクロと関数を探しましたが、この問題に一致するものを見つけることができませんでした。

編集：私は今、列Aと列Bの間に1対1のマッピングがある行を無視するようにスクリプトを取得する方法を理解しようとしています。

もう一度編集-2012年6月20日：画像を添付できるようになったので、取得しようとしている画像のスクリーンショットを次に示します。
ブライアンとマークの行は無視する必要がありますが、スコットとティムは値をコピーします。

私が探している結果


編集：列Aをマージ解除し、Andyが提供したコードを使用し、その後このVBスクリプトを使用すると、次のトリックが実行されます。

Sub mergeA（）
For i = 2 To Cells（65535、1）.End（xlUp）.Row
If IsEmpty（Cells（i、1））Then Range（Cells（i-1、1）、Cells（i、1） ）.Merge
Next
End Sub

そのVBスクリプトは、列Aのセルを元に戻します。
スクリプトは作成しませんでした。これは次のWebページからのものです：
http ：//www.vbforums.com/showthread.php？t = 601304

4

1 に答える 1

1

これにより、左側に表示されているデータが右側の出力に変換されます。

ここに画像の説明を入力してください ここに画像の説明を入力してください

Option Explicit

Sub Make_Severely_Denormalized()
  Const HEADER_ROWS As Long = 1
  Const OUTPUT_TO_COLUMN As Long = 3
  Const DELIMITER As String = vbNewLine
  Dim A_Range As Range
  Dim B_Range As Range
  Dim A_temp As Range
  Dim B_temp As Range
  Dim B_Cell As Range
  Dim Concat As String

On Error GoTo Whoops
  Set A_Range = Range("A1").Offset(HEADER_ROWS)
  Do While Not A_Range Is Nothing
    Set B_Range = A_Range.Offset(0, 1)

    ' some helper ranges
    If A_Range.Offset(1, 0).Value = "" Then
      Set A_temp = Range(A_Range, A_Range.End(xlDown).Offset(-1, 0))
    Else
      Set A_temp = A_Range.Offset(1, 0)
    End If
    Set B_temp = Range(B_Range, B_Range.End(xlDown)).Offset(0, -1)

    ' determine how high "B" is WRT no change in "A"
    Set B_Range = Range(B_Range, B_Range.Resize( _
      Application.Intersect(A_temp, B_temp, ActiveSheet.UsedRange).Count))

    ' loop through "B" and build up the string
    Concat = ""
    For Each B_Cell In B_Range
      Concat = Concat & B_Cell.Value & DELIMITER
    Next
    Concat = Left(Concat, Len(Concat) - Len(DELIMITER))

    ' do the needful
    A_Range.Offset(0, OUTPUT_TO_COLUMN - 1).Value = Concat

    ' find the next change in "A"
    If A_Range.Offset(1, 0).Value = "" Then
      Set A_Range = Application.Intersect(A_Range.End(xlDown), ActiveSheet.UsedRange)
    Else
      Set A_Range = A_Range.Offset(1, 0)
    End If
  Loop
  Exit Sub
Whoops:
  MsgBox (Err & " " & Error)
  Stop
  Resume Next
End Sub
于 2012-06-08T00:02:03.013 に答える