[已解决]VBA 语言跨sheet 如何编写？

Claireji

请教如下VBA语言跨sheet（例如提取的sheet1 里的数据保存到sheet2里）但是还在同一个excel 文件内，如何改写？非常感谢

程序如下：
Private Sub CommandButton1_Click()
    Dim arr
    Dim i, j, irow
        irow = Range("C65536").End(3).Row
        ReDim arr(1 To irow, 1 To 1)
            For i = 1 To irow
                If Cells(i, 4).Interior.ColorIndex = 36 Then
                    j = j + 1
                    arr(j, 1) = Cells(i, 4)
                End If
            Next
        Range("F1").Resize(j, 1) = arr
        
End Sub

最佳答案

月排行榜 / 总排行榜

我心飞翔410

2013-8-29 09:53

大体就是这样了

跳转到最佳答案楼层

我心飞翔410

for each sh in worksheets   对同一工作表进行循环 另外你的代码可以优化哈
Private Sub CommandButton1_Click()
    Dim arr
    Dim i, j, irow
        arr =range("c1:c"& Range("C65536").End(3).Row
            For i = 1 To ubound(arr)
                If Cells(i, 4).Interior.ColorIndex = 36 Then
                    j = j + 1
                    arr(j, 1) = Cells(i, 4)
                End If
            Next
        Range("F1").Resize(j, 1) = arr
        
End Sub
另外达到你的要求最好上个附件 带详细说明

Claireji

我心飞翔410 发表于 2013-8-28 10:55
for each sh in worksheets   对同一工作表进行循环 另外你的代码可以优化哈
Private Sub CommandButton1_ ...

谢谢你，我把附近附上，我实际使用的一个excel 中有很多sheet, 但是我只要从sheet1 中取数据到后面一个sheet2 里，是否可以定义提取数据的范围就在sheet1里面呢？哈哈~我是个初学者，就麻烦你啦~

我心飞翔410

是全部提取还是怎么说啊 你的有个要求啊 vba可以实现的提取指定的区域  问题就是你要表达清楚

我心飞翔410

看看是这样不 代码还可以优化 就看你实际需要了

Claireji

我心飞翔410 发表于 2013-8-28 14:31
看看是这样不 代码还可以优化 就看你实际需要了

我把你给的代码修改应用到我的文件后，发生了错误。麻烦帮忙看看哦~

我的目的是要将Sheet D 里的C 列黄色底纹的数据连续提取到sheet "Date from Sheet D"里的 E列。

另外，你说代码可以优化，请指出。

我心飞翔410

Claireji 发表于 2013-8-28 15:11
我把你给的代码修改应用到我的文件后，发生了错误。麻烦帮忙看看哦~

我的目的是要将Sheet D 里的C 列黄 ...

传原始附件表达清楚

Claireji

我心飞翔410 发表于 2013-8-28 15:14
传原始附件表达清楚

这是原始文件，拜托看看~

ligh1298

1. Private Sub CommandButton1_Click()
   
2.     Dim arr
   
3.     Dim i, j, irow
   
4.     Sheets("date from sheet D").Range("e:e").ClearContents
   
5.     With Sheets("D")
   
6.         arr = .Range("c1:c" & .Range("C65536").End(3).Row)
   
7.             For i = 1 To UBound(arr)
   
8.                 If Cells(i, 4).Interior.ColorIndex = 36 Then
   
9.                     j = j + 1
   
10.                     arr(j, 1) = Cells(i, 4)
    
11.                 End If
    
12.             Next
    
13.         Sheets("date from sheet D").Range("e1").Resize(j, 1) = arr
    
14.         End With
    
15. End Sub

复制代码

我心飞翔410

大体就是这样了