打开工作簿,读取工作表名称,分成块

时间:2015-05-08 13:49:01

标签: excel vba excel-vba

我需要一个

的宏
  1. 打开工作簿,
  2. 将工作表名称读入下拉菜单(因此可以选择),
  3. 输入块大小,然后输入块数
  4. 相应地拆分。
  5. 场景:我有一个数据工作簿(3个工作表),有3个人可以完成工作。我希望他们每个人从我选择的工作表中获得100行的块。然后,宏应该从工作表中删除100个三个块,并将它们粘贴到3个要分发的新工作簿中。

    来自评论:

    我有一个按钮,它运行以下代码来选择并打开工作簿:

    Sub Macro1() 
    Dim fNameAndPath As Variant, wb As Workbook 
    fNameAndPath = Application.GetOpenFilename(FileFilter:="Excel files (*.XLS), *.XLS", _
                   Title:="Select the file to be opened") 
    Workbooks.Open (fNameAndPath) 
    End Sub
    

1 个答案:

答案 0 :(得分:0)

可能是一个循环,例如

For Each ws in ActiveWorkbook.Worksheets
    Name = ws.Name
    With Sheet1.ComboBox1
        .AddItem Name
    End With
Next

单独引用每个工作表并获取每个工作表的名称并将其添加到组合框中。您可以使用

选择工作表的某个区域
ActiveSheet.Range(A1:A100)

如果您将列号作为数字接受,则此处是将该数字转换为字母的函数

Function ConvertToLetter(ColumnNumber As Integer) As String
Dim n As Long
Dim c As Byte
Dim s As String

n = ColumnNumber
'Algorithm for converting number to column letter
Do
    c = ((n - 1) Mod 26)
    s = Chr(c + 65) & s
    n = (n - c) \ 26
Loop While n > 0
ConvertToLetter = s
End Function

以下是从工作表创建新工作簿的功能的一部分。如果工作表可见,我会使用条件,但这不是必需的。

If sh.Visible = -1 Then

        sh.Copy

        'Set Destwb to the new workbook
        Set Destwb = ActiveWorkbook

        'Determine the Excel version and file extension/format
        With Destwb
            If Sourcewb.Name = .Name Then
                MsgBox "Your answer is NO in the security dialog"
                GoTo GoToNextSheet
            Else
                Select Case Sourcewb.FileFormat
                Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                Case 52:
                    If .HasVBProject Then
                        FileExtStr = ".xlsm": FileFormatNum = 52
                    Else
                        FileExtStr = ".xlsx": FileFormatNum = 51
                    End If
                Case 56: FileExtStr = ".xls": FileFormatNum = 56
                Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                End Select
            End If
        End With

        Application.DisplayAlerts = False

        'Save the new workbook and close it
        With Destwb
            .SaveAs FolderName & "\" & workbookname & FileExtStr,     FileFormat:=FileFormatNum
        End With
    End If

我知道这不是一个完整的解决方案,所以我为此道歉。但是我希望你能从这里把它拼凑起来。