这个格式可以用VBA代码来整理吗？

小葵1124

拜托大家帮忙看看~

一把小刀闯天下

'使用20楼的附件,中间数据在brr数组中可以在最后输出
'不一定正确，供参考

Option Explicit

Sub test()
  Dim i, j, k, pos, n, t, arr, sht, ii, mark, m
  pos = Split("3-2 4-3 5-4 6-5 7-6 8-7 10-8 11-9 12-10 14-11 15-12 16-13")
  sht = Split("pc端店铺来源 无线端店铺来源")
  mark = Split("PC端 无线端")
  ReDim brr(1 To Rows.Count, 1 To 17)
  For ii = 0 To UBound(sht)
    With Sheets(sht(ii))
      arr = .Range("a2:m" & .Cells(Rows.Count, "a").End(xlUp).Row + 1)
    End With
    For i = 1 To UBound(arr, 1) - 1
      If Trim(arr(i, 2)) = "来源名称" Then
        For j = i + 1 To UBound(arr, 1) - 1
          n = n + 1: brr(n, 17) = mark(ii)
          brr(n, 1) = Split(Split(arr(j, 1), "竞店入店来源对比-")(1), "_")(0)
          brr(n, 2) = arr(i - 4, 3): brr(n, 9) = arr(i - 3, 3): brr(n, 13) = arr(i - 2, 3)
          For k = 0 To UBound(pos)
            t = Split(pos(k), "-"): brr(n, Val(t(0))) = arr(j, Val(t(1)))
          Next
          If Len(Trim(arr(j + 1, 2))) = 0 Then i = j: Exit For
        Next
      End If
  Next i, ii
  ReDim arr(1 To 3 * n, 1 To 9)
  pos = Array(1, 2, 17, 3, 4, 5, 6, 7, 8, 1, 9, 17, 3, 0, 10, 11, 12, 0, 1, 13, 17, 3, 0, 14, 15, 16, 0)
  For i = 1 To UBound(arr, 1) Step 3
    n = (i - 1) / 3 + 1: m = 0
    For j = i To i + 2
      For k = 1 To UBound(arr, 2)
        If pos(m) > 0 Then arr(j, k) = brr(n, pos(m))
        m = m + 1
  Next k, j, i
  With Sheets("格式整理").[k2] '作比较用，店铺名称未作排序，自己排一下
    .Resize(Rows.Count - 11, UBound(arr, 2)).ClearContents
    .Resize(UBound(arr, 1), UBound(arr, 2)) = arr
  End With
End Sub

小葵1124

一把小刀闯天下 发表于 2018-6-13 14:18
'使用20楼的附件,中间数据在brr数组中可以在最后输出
'不一定正确，供参考

谢谢大神~ 这个怎么学啊 好难啊感觉 你们为什么可以这么容易就写出来

一把小刀闯天下

小葵1124 发表于 2018-6-13 14:30
谢谢大神~ 这个怎么学啊 好难啊感觉 你们为什么可以这么容易就写出来

先找点资料闭门造车一段时间，然后冒充胖子在这论坛上帮人做做题目，时间长了就会了。

资料网上到处都是，自己去下点就可以了。

你这需要数格子来写代码，定位起来有点晕。

小葵1124

一把小刀闯天下 发表于 2018-6-13 14:38
先找点资料闭门造车一段时间，然后冒充胖子在这论坛上帮人做做题目，时间长了就会了。

资料网上到处都 ...

厉害厉害 我还在消化你的代码，真是太厉害了，我找点资料练习练习看看 感觉这个不动手去做 很难掌握

小葵1124

一把小刀闯天下 发表于 2018-6-13 14:38
先找点资料闭门造车一段时间，然后冒充胖子在这论坛上帮人做做题目，时间长了就会了。

资料网上到处都 ...

大神 这是哪张表的格子 pos = Array(1, 2, 17, 3, 4, 5, 6, 7, 8, 1, 9, 17, 3, 0, 10, 11, 12, 0, 1, 13, 17, 3, 0, 14, 15, 16, 0)

一把小刀闯天下

小葵1124 发表于 2018-6-13 14:59
大神 这是哪张表的格子 pos = Array(1, 2, 17, 3, 4, 5, 6, 7, 8, 1, 9, 17, 3, 0, 10, 11, 12, 0, 1, 13 ...

brr数组 1-17  中间数组，可以看做是原数据
arr数组 1-9

根据要求做了一个对照表，你可以把brr数组输出到一张新的工作表上，比如在这个工作薄中插入一个新的工作表"sheet1"，然后在最后插入以下代码：
  With Sheets("sheet1").[a2]
    .Resize(Rows.Count - 1, UBound(brr, 2)).ClearContents
    .Resize(UBound(arr, 1) / 3, UBound(brr, 2)) = brr
  End With

比较“格式整理” 与"sheet1"对应的数据列之间的关系就能理解了。

小葵1124

一把小刀闯天下 发表于 2018-6-13 15:09
brr数组 1-17  中间数组，可以看做是原数据
arr数组 1-9

大神 能把你写的代码标注一下解释吗，小白看不懂，特别是定义的变量一多

小葵1124

一把小刀闯天下 发表于 2018-6-13 15:09
brr数组 1-17  中间数组，可以看做是原数据
arr数组 1-9

1-17中间数组没明白 源数据不是13列吗，哪里来的17呢？

一把小刀闯天下

小葵1124 发表于 2018-6-14 11:41
1-17中间数组没明白 源数据不是13列吗，哪里来的17呢？

跟中间数组brr比较的，没看27楼吗？

如果没有第一个问题也不会有这个中间数组了，可以在真正的源数据上直接输出结果，当然写起来会稍微复杂一点的。

其实你这并不叫汇总，而应该叫单行有条件转换成3行。最终输出的列为9列，如果单纯有规律转换那中间数组要有27列，但它实际只有17列。其中有些重复、有些为空，规律并不明显所以给你再用了一个pos数组进行重定位。