换列显示

xing_chen

ykcbf1100 发表于 2023-3-28 11:36
参与一下吧。。。

谢谢老师！运行如愿！你的代码让我喝蓝老师的代码可以对比了学习。谢谢

准提部林

gwjkkkkk 发表于 2023-3-27 18:45
Option Explicit
Sub test()
    Dim ar, br, i&, j&, r&

B/C列非空...放置行位不同的,
有點以"借貸"...上下對調~~

第5行..折扣/折让 要放上面...发票款 放下面

准提部林

Sub TEST_A1()
Dim Arr, Brr, i&, j%, K%, V, R&, N&, x%, y%
Arr = [A1].CurrentRegion
ReDim Brr(1 To UBound(Arr) * 3, 1 To 3)
For i = 2 To UBound(Arr)
    If Arr(i, 2) > 0 Then V = Arr(i, 2): N = N + 1: R = N: x = 3: y = 2
    If Arr(i, 3) > 0 Then V = Arr(i, 3): x = 2: y = 3: R = 0
    If Arr(i, 4) + Arr(i, 5) = 0 Then Arr(i, 4) = V
    For j = 4 To 5
        If Arr(i, j) > 0 Then N = N + 1: Brr(N, 1) = Arr(i, 1): Brr(N, x) = Arr(i, j)
    Next j
    If R = 0 Then N = N + 1: R = N
    Brr(R, 1) = Arr(i, 1): Brr(R, y) = V
Next i
[g2].Resize(N, 3) = Brr
End Sub

xing_chen

准提部林 发表于 2023-3-28 15:14
Sub TEST_A1()
Dim Arr, Brr, i&, j%, K%, V, R&, N&, x%, y%
Arr = [A1].CurrentRegion

谢谢老师！运行如愿！

少如

gwjkkkkk 发表于 2023-3-27 19:12
请参考。。。

请老师帮我看看，请求效果如附件：
谢谢！
两列变三列.zip (17.95 KB, 下载次数: 6)

2023-3-29 18:50 上传

点击文件名下载附件

gwjkkkkk

少如 发表于 2023-3-29 18:50
请老师帮我看看，请求效果如附件：
谢谢！

感觉有些难度，不太好弄。。。

少如

gwjkkkkk 发表于 2023-3-29 19:04
感觉有些难度，不太好弄。。。

呵呵！有难度，并不是做不到。期待中...  ...
谢谢！

我走我流

少如 发表于 2023-3-29 18:50
请老师帮我看看，请求效果如附件：
谢谢！

仅供  C AN  K A 0

xing_chen

少如 发表于 2023-3-29 18:50
请老师帮我看看，请求效果如附件：
谢谢！

老师！抱歉打扰，你的问题最好自己开个专题。因为我的此问题已解决，现在由于你的加入，又使我不得不常常看回复，生怕有老师回复我的问题自己遗漏而怠慢

少如

xing_chen 发表于 2023-3-30 12:49
老师！抱歉打扰，你的问题最好自己开个专题。因为我的此问题已解决，现在由于你的加入，又使我不得不常常 ...

好的，请你帮我删除吧。谢谢！