首页
学习
活动
专区
圈层
工具
发布
社区首页 >问答首页 >(VBA)基于活动工作表中匹配的单元格值在多个单独的工作表中查找和复制行的一部分

(VBA)基于活动工作表中匹配的单元格值在多个单独的工作表中查找和复制行的一部分
EN

Stack Overflow用户
提问于 2012-12-13 01:58:13
回答 1查看 442关注 0票数 2

我希望标题不会太混乱!

基本上,我自己在Excel中有一个清单。我有一个工作表作为我的菜单,我有一个工作表为每个客户(例如,TD银行,罗杰斯,标准人寿),它是这样的(在这个例子中,以Videotron作为我的客户):

代码语言:javascript
复制
    A           B          C                 D      E            F        G         H
1   CLIENT      UNIQUEID   MATERIALTYPE      SIZE   MATERIALCODE LOCATION QTYPERBOX TOTALQTY
2   Videotron   VID-001    Outgoing Envelope 9x12   VID-OE0812   4-1-3    500       15000
3   Videotron   VID-002    Letterhead        8.5x14 VID-LH0812   1-1-1    2500      50000
4   Videotron   VID-003    Reply Envelope    #9     VID-RE0812   8-5-2    1000      7500

我需要帮助的工作表是我的' locations‘表,它包含了我仓库中所有物理位置的列表,如下所示:

代码语言:javascript
复制
     A          B        C          D              E      F              G           H
     LOCATION   CLIENT   UNIQUEID   MATERIALTYPE   SIZE   MATERIALCODE   QTYPERBOX   TOTALQTY 
1    1-1-1    
2    1-1-2
3    1-1-3
4    1-2-1
5    1-2-2
6    1-2-3
     etc. etc.

对于每个位置,其中一个客户端工作表中会有一个条目,可以在任何位置。如果我们以物理位置'1-1-1‘为例,根据所示的工作表,我有一个包含50,000个Videotron信头的托盘。我需要的代码是在所有客户端工作表中搜索' 1 -1-1‘,一旦找到,就将信息复制到上面第1行的列B:H中。然后,我需要对第2行中的位置'1-1-2’执行相同的过程,以此类推,直到我的最后一个位置为'8-8-3‘。

我们的目标是让'Locations‘工作表本身填充来自客户端工作表的正确信息,反过来,这些信息将始终真实地反映当前的实物库存。这意味着如果我从位置'1-1-1‘中删除10,000个信封,它将在’位置‘工作表中自动更新。一个类似的场景是,如果我在我的仓库中物理地交换了2个托盘,假设我交换了位置'1-1-1‘的托盘和'2-3-1’中的托盘,并在我的客户工作表中进行了更改……我需要‘位置’工作表来反映变化。

我看过许多代码片段,其中很多我认为可以帮助我,但它只涉及我试图实现的一部分,我没有足够的知识或理解来将它们与我的工作簿拼凑在一起。

有没有人认为这是可能的,或者我只是在做梦?

编辑:应该说我在Excel2003中。

EN

回答 1

Stack Overflow用户

发布于 2013-01-04 21:10:19

根据我的评论,我仍然认为它需要一个数据库,但我意识到业务限制可能会使您偏离最有效的方式,因为这是现实。

所以。也许你可以试试这样的..。

代码语言:javascript
复制
Sub sortInventory()
Dim wsInv As Worksheet
Dim wsCust As Worksheet

Dim rngSearch As Range
Dim cellSearch As Range
Dim rngLoc As Range
Dim rngCurLoc As Range

Dim findVal As String

Dim locCol As Integer, custCol As Integer

Dim locFound As Boolean





Set wsInv = ActiveWorkbook.Sheets("Locations")
Set rngLoc = wsInv.Range("A1", wsInv.Range("A1").End(xlDown))

For Each rngCurLoc In rngLoc.Cells
'This is what you're looking for in each sheet.
    findVal = rngCurLoc.Value
    locFound = False
    For Each wsCust In ActiveWorkbook.Sheets
        If locFound Then Exit For

       'Exclude the location sheet
        If wsCust.Name = "Locations" Then
         Next wsCust
        End If

        Set rngSearch = wsCust.Range("F1", Range("F1").End(xlDown))

        For Each cellSearch In rngSearch.Cells
        'Look for your value
            If cellSearch.Value = findVal Then ''Alternate method could use the "find"
            'Transfer to Locations
            'Use an offset loop to pick/place map to new location.

                 For custCol = 1 To 8 '8 can modify to the width of your data (I think it's 8)
                Select Case custCol
                    Case Is <= 5 'The first 5 are offset by one to the location sheet.
                        wsInv.Cells(rngCurLoc.Row, custCol + 1).Value = wsCust.Cells(cellSearch.Row, custCol).Value
                    Case 6 'Location column
                        ''Do nothing.
                    Case Else 'Direct map
                        wsInv.Cells(rngCurLoc.Row, custCol).Value = wsCust.Cells(cellSearch.Row, custCol).Value
                End Select
            Next custCol
            locFound = True 'This will kick the 2nd loop out to the range loop.
            Exit For
        End If
    Next wsCust
Next rngCurLoc




End Sub

我不能真的测试它,当我把它粘贴到这里的代码块中时,the键变得有点有趣,这样控制循环就不会超级排成一行。无论如何,它应该会让你开始。它的对象和集合都很繁重,但如果不严格定义您要做的事情,VBA代码可能会变得非常脆弱。

票数 0
EN
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接:

https://stackoverflow.com/questions/13845796

复制
相关文章

相似问题

领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档