Question

在堆栈社区的帮助下，我开发了一段代码，将每列标题放在一个工作簿中，并在另一个工作簿中创建这些标题的列表。现在我需要一段代码来复制所选标题的整个列。

以下是创建列表的代码：

Private Sub Main()

    Application.ScreenUpdating = False
    Set wb2 = ThisWorkbook
    Dim foldername As Variant
    Dim wb1 As Workbook
    foldername = Application.GetOpenFilename
    If foldername <> False Then
    Set wb1 = Workbooks.Open(foldername)
    Application.ScreenUpdating = True

    Dim destination As Worksheet
    Dim emptyColumn As Long
    Dim lastFullColumn As Long
    Dim emptyColumnLetter As String
    Dim lastFullColumnLetter As String
    Dim ws1 As Worksheet
    Dim rng1 As Range
    Dim ws2 As Worksheet
    Dim rng2 As Range
    Set ws2 = wb2.Sheets(1)
    Set ws1 = wb1.Sheets(1)
    Dim lastFullColumn1 As Long
    Dim lastFullColumn2 As Long

    Set destination = ws2

    'Find the last column with something on the first row
    lastFullColumn = destination.Cells(1,      destination.Columns.Count).End(xlToLeft).Column
    If lastFullColumn > 1 Then
    emptyColumn = lastFullColumn + 1
    End If

     'Create the list with rows titles

    lastFullColumn1 = ws1.Cells(1, ws1.Columns.Count).End(xlToLeft).Column
    lastFullColumn2 = ws2.Cells(1, ws2.Columns.Count).End(xlToLeft).Column + 1

    Set rng1 = ws1.Range(ws1.Cells(1, 1), ws1.Cells(1, lastFullColumn1))
    Set rng2 = ws2.Range(ws2.Cells(1, lastFullColumn2),      ws2.Cells(lastFullColumn1, lastFullColumn2))

    rng2.Value2 = Application.Transpose(rng1)

    With ws2.Range("E14").Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
    Operator:=xlBetween, Formula1:="=" & rng2.Address
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = "LIST"
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = True
    End With
    End If
End Sub

对于在选择选择时使列表复制的代码，我正在考虑这些问题，但我无法让它工作：

Sub CopyHeadings()

    If Target.Address = Range("E14").Address Then
    For i = 1 To lastFullColumn1
    If Range("E14").Value = Range(i).Value Then
         wb1.Sheets("Sheet1").Columns(i).Copy destination:=wb2.Sheets("Sheet1").Columns(emptyColumn)

    End If
    Next i
    End If
End Sub

我想在第一行中循环遍历第一个工作簿中的所有列，然后如果它遇到与列表所在的工作簿2中的单元格中的值匹配的值，让它从工作簿中复制整个列1到第二个工作簿上的下一个打开的列可以工作，但如果有人有更好的攻击计划，我很乐意听到它，谢谢！

所以我试着离开你的榜样，这就是我所拥有的：

Public Sub CopyHeadings(ByRef ws1 As Worksheet, ByRef ws2 As Worksheet,  Target As Range)
    Dim i As Long
    Dim lastFullColumn1 As Long
    Dim rngE14 As Range

    Set rngE14 = ws2.Range("E14").Value
    lastFullColumn1 = ws1.Cells(1, ws1.Columns.Count).End(xlToLeft).Column

    If Target.Address = ws2.Range("E14").Address Then
        For i = 1 To lastFullColumn1
            If rngE14 = ws1.Range(i).Value Then ws1.Columns(i).Copy ws2.Columns(i)
        Next i
    End If
End Sub

它没有返回任何错误，但它仍然没有复制并粘贴从ws1到ws2的任何信息。它只是让我选择一个宏，然后它运行该宏。虽然要运行宏，但CopyHeadings不会出现在列表中。

Answer 1

子<style> .bottn { overflow: hidden; margin-left: 10px; } @media print { @page {size: landscape;} .bottn{ visibility: hidden; } rect { width: 100% !important; height: 100% !important; } } </style> .... <script>google.load('visualization', '1.0', {'packages':['corechart']}); google.setOnLoadCallback(drawTempChart); function drawTempChart() { var DATA = google.visualization.arrayToDataTable([ ...... ], false); var data = DATA; var options = { width:"100%", height:"100%", title: 'Harsh Acceleration Report', hAxis: { title: 'Vehicles', }, vAxis: { title: 'Harsh Acceleration Events' } }; var chart = new google.visualization.ColumnChart(document.getElementById('graph')); chart.draw(data, options); } window.onresize = function(event) { drawTempChart(); } </script> .... <body> <a class='bottn' href='javascript:window.print();'>Print</a><div id="graph" style="width: 100%; height: 100%";></div> </body>中的变量超出范围（未经过测试，因此请相应调整）

CopyHeadings

测试子：

Public Sub CopyHeadings(ByRef ws1 As Worksheet, ByRef ws2 As Worksheet, Target As Range)
    Dim i As Long, lastCol1 As Long, rngE14 As Range

    rngE14 = ws2.Range("E14").Value
    lastCol1 = ws1.Cells(1, ws1.Columns.Count).End(xlToLeft).Column

    If Target.Address = ws2.Range("E14").Address Then
        For i = 1 To lastCol1
            If rngE14 = ws1.Range(i).Value Then ws1.Columns(i).Copy ws2.Columns(i)
        Next i
    End If
End Sub

你的主要分组：

Public Sub testColumnCopy()
    Dim ws1 As Worksheet, ws2 As Worksheet, fileID As Variant

    fileID = Application.GetOpenFilename
    If fileID <> False Then
        Set ws1 = ThisWorkbook.Sheets("Sheet1")
        Set ws2 = Workbooks.Open(fileID).Sheets("Sheet1")
        CopyHeadings ws1, ws2, ws2.Range("E14")
    End If
End Sub

创建列表选择从另一个工作表复制列数据

1 个答案: