[已解决]请教提取符合条件的数据，且数据部分变成负数

chensir

请教各位把A列中含有“多品”A:E列的数据，放到H:L列，并且B:E列的数据变成负数，放到I:L列，请问各位如何用语句实现。
无法上附件
A               B                      C            D                E             F    G    H                I                    J                K                       L

分销系统名称	01营运费	02商场促销费	03办公耗材	04修理费			分销系统名称	01营运费	02商场促销费	03办公耗材	04修理费
A多品店AD	1000.00	1000.00	1000.00	1000.00			A多品店AD	-1000.00	-1000.00	-1000.00	-1000.00
E店	1000.00	1000.00	1000.00	1000.00			B多品店	-1000.00	-1000.00	-1000.00	-1000.00
B多品店	1000.00	1000.00	1000.00	1000.00
C店	1000.00	1000.00	1000.00	1000.00
D店	1000.00	1000.00	1000.00	1000.00

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-3-29 10:03

1. Sub 复制()
   
2.     Dim arr, brr()
   
3.     arr = Range("a1").CurrentRegion
   
4.     Dim i As Long, l As Long, k As Long
   
5.     If Not IsArray(arr) Then MsgBox "数据不足": Exit Sub
   
6.     ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
   
7.     For i = LBound(arr) + 1 To UBound(arr)
   
8.         If arr(i, 1) Like "*多品*" Then
   
9.             l = l + 1
   
10.             brr(l, 1) = arr(i, 1)
    
11.             For k = LBound(arr, 2) + 1 To UBound(arr, 2)
    
12.                 brr(l, k) = arr(i, k) * -1
    
13.             Next
    
14.         End If
    
15.     Next
    
16.     Range("h1").Resize(, UBound(arr, 2)) = WorksheetFunction.Index(arr, 1, 0)
    
17.     Range("h2").Resize(l, UBound(brr, 2)) = brr
    
18. End Sub

复制代码

跳转到最佳答案楼层

hwc2ycy

可以直接筛选，再复制可见单元格，再用复粘，选择性粘贴嘛。

hwc2ycy

你上个附件，这个代码很容易的。

rebornxldeng

hwc2ycy 发表于 2013-3-29 09:55
你上个附件，这个代码很容易的。

你让他根据你上面所说的操作录一次宏...不就行了么{:051:}
你觉得代码容易是因为这个问题的解决思路只涉及到单个的分支选择.
要是看不懂代码的人.不是就要被打击了么.

hwc2ycy

1. Sub 复制()
   
2.     Dim arr, brr()
   
3.     arr = Range("a1").CurrentRegion
   
4.     Dim i As Long, l As Long, k As Long
   
5.     If Not IsArray(arr) Then MsgBox "数据不足": Exit Sub
   
6.     ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
   
7.     For i = LBound(arr) + 1 To UBound(arr)
   
8.         If arr(i, 1) Like "*多品*" Then
   
9.             l = l + 1
   
10.             brr(l, 1) = arr(i, 1)
    
11.             For k = LBound(arr, 2) + 1 To UBound(arr, 2)
    
12.                 brr(l, k) = arr(i, k) * -1
    
13.             Next
    
14.         End If
    
15.     Next
    
16.     Range("h1").Resize(, UBound(arr, 2)) = WorksheetFunction.Index(arr, 1, 0)
    
17.     Range("h2").Resize(l, UBound(brr, 2)) = brr
    
18. End Sub

复制代码

lisachen

1. 烟花真快

复制代码

hwc2ycy

代码我这没有数据测试，交楼主了，有问题再说。

chensir

谢谢，各位                     

chensir

hwc2ycy 发表于 2013-3-29 10:03

brr(l, k) = arr(i, k) * -1
这提示类型不对什么原因

hwc2ycy

你上附件吧，你数据在列里是不是有文本啊。