繁体   English   中英

如何将单元格值从WorkSheet1复制到WorkSheet,又如何使用VBA在Excel中创建主列表?

[英]How to copy cell values from WorkSheet1 to WorkSheet, aka, how to create a masterlist in Excel using VBA?

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

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

这有意义吗? 可以这样做吗? 提前致谢!

欢迎使用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

由于斯科特,问题解决了。 如果单元格中包含的字符多于Excel的标准最大值。 然后在第一行“If NOT ...”语句中插入此代码而不是这行代码Set rngFoundAgain = rngFound.EntireRow.Find(cel.Text,lookat:=xlWhole)插入此行:

Set rngFoundAgain = rngFound.EntireRow.Find(Left(cel.Value, 255), lookat:=xlWhole)

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM