循环表和传输数据

时间:2015-10-16 19:32:19

标签: excel excel-vba vba

我的大脑被炸了,这对于通常的嫌疑人来说很容易。 dealers.js是一个包含工作表名称的数组。我正在循环读取主书中的工作表,如果其中一个主工作表与div数组中的一个工作表匹配,我想将一些数据从主工作表传输到div中的工作表。< / p>

如果thisworkbook中不存在工作表,请添加一个并在主工作表后面命名。最有效的方法是什么?我觉得嵌套循环是一个坏主意-_-也许是一个集合?

thisworkbook

我甚至需要检查表格是否存在?代码从Tim被盗。

For i = 0 To UBound(div())

    For Each s In book.Worksheets

        wsName = Left(s.Name, 5)

        If div(i) = wsName Then
        If wsExists(wsName) Then
            Set ws = ThisWorkbook.Worksheets(wsName)
            Exit For
            'Debug.Print "true " & ws.name
        Else
            Set ws = ThisWorkbook.Worksheets.Add
            ws.Name = Left(s.Name, 5)
            'Debug.Print "false " & ws.name
        End If
        end if
    Next

    With ws
    .Columns(Start).Resize(, 2).Value = s.Columns("A:B").Value
    .Columns(Start + label).Resize(, cols).Value = s.Columns(Start + label).Resize(, cols).Value
    End With

Next

编辑:我从一个单独的例程调用循环。

Function wsExists(sName As String) As Boolean
Dim sht As Worksheet

On Error Resume Next
Set sht = ThisWorkbook.Sheets(sName)
On Error GoTo 0
wsExists = Not sht Is Nothing

End Function

其中Call drop(thisWB, thisRange, ccArr)

ccArr

上面循环所在的例程打开

Dim ccArr() As Variant
ccArr = Array("30500", "30510", "30515", "30530", "30600", "30900", "40500")

但是我在尝试传递数组时遇到Sub drop(book As Workbook, cols As Integer, div As Variant, Optional startCol As Integer) 错误; _;

2 个答案:

答案 0 :(得分:1)

你的嵌套循环是多余的。您可以直接针对要检查的工作簿检查来自div的工作表名称,然后根据需要添加它。

请参阅下面的代码,该代码还解决了对OP进行编辑的问题。我修改了wsExists函数以包含对特定工作簿的集合引用,我认为它使其更具动态性。

'assumes thisWB  and thisRange set above

Dim ccArr() As String, sList As String
sList = "30500,30510,30515,30530,30600,30900,40500"
ccArr = Split(sList, ",")

drop thisWB, thisRange, ccArr 'assumes thisWb and thisRange are set already

' rest of code
'==================================================

Sub drop(book As Workbook, cols As Integer, div() As String, Optional startCol as Integer)

For i = 0 To UBound(div())

    If wsExists(ThisWorkbook, div(i)) Then
        Set ws = ThisWorkbook.Worksheets(div(i))
        Exit For
        'Debug.Print "true " & ws.name
    Else
        Set ws = ThisWorkbook.Worksheets.Add
        ws.Name = div(i)
    End If

    'i think you need this here, otherwise, it will only work on the last worksheet in your loop
    With ws
        Dim s As Worksheet
        Set s = book.Sheets(div(i))
        .Columns(Start).Resize(, 2).Value = s.Columns("A:B").Value
        .Columns(Start + Label).Resize(, cols).Value = s.Columns(Start + Label).Resize(, cols).Value
    End With

Next

End Sub

Function wsExists(wb As Workbook, sName As String) As Boolean
Dim sht As Worksheet

On Error Resume Next
Set sht = wb.Sheets(sName)
On Error GoTo 0
wsExists = Not sht Is Nothing

End Function

答案 1 :(得分:1)

与重新调整代码相关:

此声明ws.Columns(1).Resize(, 2)转换为“第1列和第2列的200万+行”

您找到的解决方案运行良好但不是动态的(硬编码的最后一行)

这就是我设置列副本的方式:

Option Explicit

Public Sub copyCols()
    Dim ws1 As Worksheet, ws2 As Worksheet, rng1 As Range, rng2 As Range
    Dim cols As Long, lr As Long

    Dim col1 As Long    'renamed from "Start" (VBA keyword - property)
    Dim lbl As Long     'renamed from "label" (VBA keyword - Control object)

    Set ws1 = Sheet1    'ws
    Set ws2 = Sheet2    'book.Worksheets(wsName & "-F")

    col1 = 1
    cols = 2
    lbl = 1

    lr = ws2.Cells(ws2.UsedRange.Row + ws2.UsedRange.Rows.Count, "A").End(xlUp).Row

    Set rng1 = ws1.Range(ws1.Cells(1, col1), ws1.Cells(lr, col1 + 1))
    Set rng2 = ws2.Range("A1:B" & lr)

    rng1.Value2 = rng2.Value2

    Set rng1 = ws1.Range(ws1.Cells(1, col1 + lbl), ws1.Cells(lr, col1 + lbl + cols))
    Set rng2 = ws2.Range(ws2.Cells(1, col1 + lbl), ws2.Cells(lr, col1 + lbl + cols))

    rng1.Value2 = rng2.Value2 
End Sub