求二维码转一维的，在线求

840205910

Sub 转置()
Application.DisplayAlerts = False
Set d = CreateObject("Scripting.Dictionary")
[a18:e5000].Clear
Arr = [a1].CurrentRegion
For i = 5 To UBound(Arr)
  For j = 5 To UBound(Arr, 2) - 1
     If Arr(i, j) <> "" Then
           If Arr(2, j) <> "" And Arr(i, 1) = Arr(2, 4) Then
              x = Arr(i, 1) & "|" & Arr(i, 2) & "|" & Arr(i, 3) & "|" & Arr(2, j)
            ElseIf Arr(3, j) <> "" And Arr(i, 1) = Arr(3, 4) Then
              x = Arr(i, 1) & "|" & Arr(i, 2) & "|" & Arr(i, 3) & "|" & Arr(3, j)
            ElseIf Arr(4, j) <> "" And Arr(i, 1) = Arr(4, 4) Then
              x = Arr(i, 1) & "|" & Arr(i, 2) & "|" & Arr(i, 3) & "|" & Arr(4, j)
            ElseIf Arr(1, j) <> "" Then
              x = Arr(i, 1) & "|" & Arr(i, 2) & "|" & Arr(i, 3) & "|" & Arr(1, j)
            End If
          d(x) = Arr(i, j)
      End If
  Next
Next
[a18].Resize(d.Count) = Application.Transpose(d.keys)
[a18].Resize(d.Count).TextToColumns OtherChar:="|", other:=True
[e18].Resize(d.Count) = Application.Transpose(d.items)
Application.DisplayAlerts = True
End Sub

840205910

求转换1023.zip (309.95 KB, 下载次数: 42)

2012-10-24 17:35 上传

点击文件名下载附件

heleipower

这个帖子厉害。大神都出来了。

蔡明江

zhaogang1960 发表于 2012-10-24 16:25
请注意：D列数据要准确，如：
茄克/牛仔西服/T恤/毛衣/衬衫/棉服/羽绒
中间不能出现换行符，也不能有“夹 ...

很好用的方法 学习！