0

私が持っているいくつかのExcelデータのマスターリストを作成しようとしています。私はExcel+VBAプログラム/コードを使ったことがありません。

WorkSheet1には2つの列があります。Column1はある種の単語、用語であり、Column2はColumn1の定義を保持します。ここで、そのColumn1の定義をコピーし、対応するColumn1のすぐ隣のWorkSheet2のColumn2（空の場合は、Column3または次の空の列）に配置する必要があります。WorkSheet1の残りの行に対してこれを続けます。基本的に、同じ値の繰り返しがあってはなりません。WorkSheet2のColumn1は、同じでない限り、複数の定義列を持つことができます。

これは意味がありますか？このようなことは可能ですか？前もって感謝します！

4

2 に答える 2

2

ExcelVBAへようこそ。私があなたの投稿を正しく理解していれば、これはあなたが何を求めているのか（少なくとも基本的なこと）をあなたに与えるはずです。これは、特定のワークブックとデータセットに基づいて調整する必要がある場合がありますが、すばらしいスタートを切ることができます。私が使用したすべての方法/手順については、たくさんのヘルプが利用できます。何が起こっているのかを理解できるように、英語でうまくコメントするようにしています。

Option Explicit

Sub MoveIt()

Dim wkb As Workbook
Set wkb = ActiveWorkbook 'change to your workbook reference

Dim wks1 As Worksheet, wks2 As Worksheet
Set wks1 = wkb.Sheets("Sheet1") 'change to your name / definition sheet
Set wks2 = wkb.Sheets("Sheet2") 'change to the sheet where you need to paste defintions

With wks1

    Dim rngLoop As Range, cel As Range
    'assumes row 1 as column header, and definitions in Column B (2)
    Set rngLoop = Intersect(.UsedRange, .UsedRange.Offset(1), .Columns(2)) 'basically all rows with definitions in Column 2

    For Each cel In rngLoop 'loop through each definition


        Dim rngFound As Range

        'look for associated definition name in 2nd sheet
        'assumes Name in Column 1 of both worksheets
        Set rngFound = wks2.Columns(1).Find(cel.Offset(, -1).Text, lookat:=xlWhole)


        If Not rngFound Is Nothing Then 'if the name is found

            'look to see if defintion already exists in row aligned with Name of 2nd sheet
            Dim rngFoundAgain As Range
            Set rngFoundAgain = rngFound.EntireRow.Find(cel.Text,lookat:=xlWhole)

            'if not found
            If rngFoundAgain Is Nothing Then

                If rngFound.Offset(, 1) = vbNullString Then
                'if next cell (row of rngFound, column B) is blank

                    rngFound.Offset(, 1) = cel.Text

                Else
                'go the right most cell and place definition in next column

                    rngFound.End(xlToRight).Offset(, 1) = cel.Text

                End If

            End If

        End If

    Next

End With


End Sub
于 2012-06-26T16:43:40.627 に答える
0

スコットのおかげで問題は解決しました。セルがExcelの標準の最大値よりも多くの文字を保持している場合。次に、最初の「If NOT ...」ステートメント内のこのコード行の代わりに、このコードを次の行にSet rngFoundAgain = rngFound.EntireRow.Find(cel.Text,lookat:=xlWhole)プラグインします。

Set rngFoundAgain = rngFound.EntireRow.Find(Left(cel.Value, 255), lookat:=xlWhole)
于 2012-06-28T15:17:57.850 に答える