教下各位老师如何把AA表的子物料数据，能自动导入BB所对应的数据中 并且横向

renlin66666

教下各位老师如何把AA表的子物料数据，能自动导入BB所对应的数据中  并且横向 ，最好能根据数量大小 依次向后排  

cutecpu

Sub demo()
   a = Sheets(1).UsedRange
   r = 1
   With Sheets(2)
      .UsedRange.Offset(1, 0).ClearContents
      .[g1:xfd1].Clear
      For i = 2 To UBound(a)
         If a(i, 1) <> p Then
            r = r + 1: c = 1
            .Cells(r, 1).Resize(1, 3) = Array(a(i, 1), a(i, 2), a(i, 3))
            p = a(i, 1)
         End If
         c = c + 3: If c > maxc Then maxc = c
         .Cells(r, c).Resize(1, 3) = Array(a(i, 12), a(i, 14), a(i, 15))
      Next
      .[d1:f1].Copy [d1].Resize(, maxc - 1)
      .Columns(1).Resize(, maxc + 2).AutoFit
   End With
End Sub

祝順心，南無阿彌陀佛！

renlin66666

cutecpu 发表于 2021-8-6 15:58
Sub demo()
   a = Sheets(1).UsedRange
   r = 1

非常感谢  我来研究研究   真是太感谢你了   

renlin66666

renlin66666 发表于 2021-8-6 16:09
非常感谢  我来研究研究   真是太感谢你了

不好意思  又打扰你了  我在前面插入列 我看了你的代码  没研究出来 您 帮我看看好吗  代码里 c = c + 7: If c > maxc Then maxc = c  我把3改成7 结果后面的所有7物料也占用了7列 。我子物料前面我还有可能加很多列   

cutecpu

renlin66666 发表于 2021-8-6 22:28
不好意思  又打扰你了  我在前面插入列 我看了你的代码  没研究出来 您 帮我看看好吗  代码里 c = c + 7: ...

您好，您上傳一下您修改過後的代碼

renlin66666

cutecpu 发表于 2021-8-6 22:43
您好，您上傳一下您修改過後的代碼

我啥也没改 就是把C=C+3  改成了7  可是我前面是空了7列  可是后面  对应的 子物料也从3列变成了7列 。。。我前面可能加很多列
Sub demo()
   a = Sheets(1).UsedRange
   r = 1
   With Sheets(2)
      .UsedRange.Offset(1, 0).ClearContents
      .[i1:xfd1].Clear
      For i = 2 To UBound(a)
         If a(i, 1) <> p Then
            r = r + 1: c = 1
            .Cells(r, 1).Resize(1, 3) = Array(a(i, 1), a(i, 2), a(i, 3))
            p = a(i, 1)
         End If
         c = c + 7: If c > maxc Then maxc = c
         .Cells(r, c).Resize(1, 3) = Array(a(i, 12), a(i, 14), a(i, 15))
      Next
      .[d1:f1].Copy [d1].Resize(, maxc - 1)
      .Columns(1).Resize(, maxc + 2).AutoFit
   End With
End Sub

cutecpu

renlin66666 发表于 2021-8-6 23:02
我啥也没改 就是把C=C+3  改成了7  可是我前面是空了7列  可是后面  对应的 子物料也从3列变成了7列 。。 ...

之后改红色的地方就可以了

Sub demo()
   Header = 7
   a = Sheets(1).UsedRange
   r = 1
   With Sheets(2)
      .UsedRange.Offset(1, 0).ClearContents
      .Range(Cells(1, Header + 4), Cells(1, "xfd")).Clear
      For i = 2 To UBound(a)
         If a(i, 1) <> p Then
            r = r + 1: c = Header - 2
            .Cells(r, 1).Resize(1, Header) = Array(a(i, 1), a(i, 2), a(i, 3), 4, 5, 6, 7)
            p = a(i, 1)
         End If
         c = c + 3: If c > maxc Then maxc = c
         .Cells(r, c).Resize(1, 3) = Array(a(i, 12), a(i, 14), a(i, 15))
      Next
      .Cells(1, Header + 1).Resize(1, 3).Copy .Cells(1, Header + 1).Resize(, maxc + 2 - Header)
      .Columns(1).Resize(, maxc + 2).AutoFit
   End With
End Sub

祝順心，南無阿彌陀佛！

renlin66666

cutecpu 发表于 2021-8-6 23:36
之后改红色的地方就可以了

Sub demo()

谢谢你   能请教下  ，你真厉害 ，，达到你这样的水平要学习哪些知识，太厉害了

renlin66666

谢谢  我明白了    非常感谢

cutecpu

renlin66666 发表于 2021-8-7 07:54
谢谢你   能请教下  ，你真厉害 ，，达到你这样的水平要学习哪些知识，太厉害了

您好，
大部份的知识，都是上网查的
大量在论坛里试着回答当练习
过程中有不懂的，一定要弄懂
以上，大致是我学习的方法

祝順心，南無阿彌陀佛！