求助,将差额不为0的合约列到另外一列

ljxy925

各位大师,我又遇到问题了

如图中:
第2列不为零的单元格,对应第1列单元格的内容,填到第5列第一行中,有多个的话,用逗号分隔;
第3列不为零的单元格,对应第1列单元格的内容,填到第6列第一行中,有多个的话,用逗号分隔;
用VBA代码实现
谢谢了


file:///C:/Users/jack/AppData/Roaming/Tencent/Users/42608897/TIM/WinTemp/RichOle/%60738$H7%25P@K%7DLV%7BKL]N(S94.png

xiangbaoan

sub test()
dim ar,r&,s1$,s$
ar=[a1].currentregion.resize(,3)
for r=2 to ubound(ar)
if val(ar(r,2)) then s1=s1 &  ","  & ar(r,1)
if val(ar(r,3)) then s2=s2 &  ","  & ar(r,1)
next
if len(s1) then [e2]=mid(s1,2)
if len(s2) then [f2]=mid(s1,2)
end   sub

ljxy925

谢谢大师
这是数组的意思，看不大懂呀

ljxy925

昨天,受大师启发.写了一个基础版的
请大师指正

Sub demo()
   
    Dim bzjce As String
    Dim sxfce As String
    Dim sl  As Integer
    Dim i As Integer
   
    sl = Range("a65536").End(xlUp).Row
   
    For i = 2 To sl
        
        If Range("b" & i) <> 0 Then
            
            bzjce = Range("b" & i).Offset(0, -1) & "，" & bzjce
            
        End If
        
        If Range("c" & i) <> 0 Then
            
            sxfce = Range("c" & i).Offset(0, -2) & "，" & sxfce
            
        End If
   
    Next
   
    Range("e" & 2) = bzjce
    Range("f" & 2) = sxfce
   
    Columns().AutoFit

End Sub

xiangbaoan

ljxy925 发表于 2018-8-16 13:54
昨天,受大师启发.写了一个基础版的
请大师指正

没有附件，不过看着应该还可以,很不错的！！我的是想当然看图写的，最后一行应为：
if len(s2) then [f2]=mid(s2,2)