[已解决]求高手帮忙修改代码

h486

蓝粆 发表于 2014-3-29 23:57
还不怎么能看懂、、、

之前我问的那段用字典法写的代码，等了好久没人回答，看了点书总算看懂了，就是不知道怎么改！我这段就是那段分解出来的，就差条件设置了。

pengyx

hwc2ycy 的代码改了一点点，请楼主试试，行不行回一个
Sub test()
Dim x%, j%, i%
j = 3
x = 2
For i = 1 To 5 Step 4
Do While j <= 33
    If Sheet2.Range("a" & x) = "b部门" Or Sheet2.Range("a" & x) = "c部门" Then
        Cells(j, i).Resize(1, 3) = Sheet2.Range("a" & x, "c" & x).Value
        j = j + 1
    End If
    x = x + 1
Loop
j = 3
Next
End Sub

h486

pengyx 发表于 2014-3-30 01:32
hwc2ycy 的代码改了一点点，请楼主试试，行不行回一个
Sub test()
Dim x%, j%, i%

感谢你的热心，谢谢！
我这个表是做工资用的，因为项目少，需要按部门张贴，这里就需要if语句（因为是多条件就非常麻烦），加上数据需要在一张表格内分成先左后右排列的表格，数据又超过60行，这就难倒我了。

hwc2ycy

我现在才看明白你想要实现什么。？
建议以后提问题，要把代码要实现的功能，碰到了什么问题，最后的效果图都一一附上，这样才有利于快速解决问题。

dsmch

1. Sub test()
   
2. On Error Resume Next
   
3. Dim rng As Range, arr, i&, s&, x&, d
   
4. Set d = CreateObject("scripting.dictionary")
   
5. arr = Sheet2.Range("a1").CurrentRegion
   
6. Sheet1.Activate
   
7. Set rng = Union([a3:a32], [e3:e32])
   
8. rng.ClearContents
   
9. For Each cel In rng
   
10.     x = x + 1
    
11.     d(x) = cel.Address
    
12. Next
    
13. For i = 2 To UBound(arr)
    
14.     If arr(i, 1) = "b部门" Or arr(i, 1) = "c部门" Then
    
15.         s = s + 1
    
16.         Range(d(s)).Resize(1, 3) = Application.Index(arr, i, 0)
    
17.     End If
    
18. Next
    
19. End Sub
    

复制代码

dsmch

………………

h486

dsmch 发表于 2014-3-30 09:23
………………

谢谢！

h486

hwc2ycy 发表于 2014-3-30 08:38
我现在才看明白你想要实现什么。？
建议以后提问题，要把代码要实现的功能，碰到了什么问题，最后的效果图 ...

谢谢版主！

h486

真是高实在是高

h486

hwc2ycy 发表于 2014-3-30 08:38
我现在才看明白你想要实现什么。？
建议以后提问题，要把代码要实现的功能，碰到了什么问题，最后的效果图 ...

http://www.excelpx.com/thread-321976-1-1.html版主请看下，如有表述不清的，还请告知，谢谢！