0

我正在尝试创建我拥有的几个 excel 数据的主列表。我从未使用过 Excel + VBA 程序/代码。

WorkSheet1 中有 2 列。Column1 是某种单词、术语，而 Column2 包含 Column1 的定义。现在，我必须复制该 Column1 的定义并将 Column2（如果为空，如果不是，则在 Column3 或下一个空列中）放入对应 Column1 旁边的 WorkSheet2 中。继续对 WorkSheet1 中的其余行执行此操作。基本上，不应有任何重复相同的值。WorkSheet2 中的Column1 可以有多个定义Column，只要它们不相同即可。

这有意义吗？有可能做这样的事情吗？提前致谢！

4

2 回答 2

2

欢迎使用 Excel VBA。如果我正确理解你的帖子，这应该给你（至少是基本的）你所追求的东西。这可能需要根据您的特定工作簿和数据集进行调整，但它会给您一个很好的开始。我使用的所有方法/程序都有大量帮助，我尝试用英语很好地评论，以便您了解正在发生的事情。

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

感谢Scott，问题解决了。如果单元格包含的字符数超过 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 回答