Question

嘿伙计们，我面临的问题是vba代码只能在特定行上查找某个值，从“第7行A列”开始（例如）直到“第7行最后一列表”。

我尝试实现的目标：

excel上的一个按钮，其中包含用于打开输入对话框的代码VBA。根据输入中给出的值，我应该只搜索！在特定行（仅1行）。我从该行的A列开始按行搜索值，我需要循环直到该行的最后一个单元格。

如果代码在C7上找到值，例如第7行C列，我需要将整个列复制到另一个工作表，然后再次开始查找从上次找到的单元格开始的值。因此，如果代码找到包含第7行G列的另一列，请再次执行该操作。

问题是，如果找到多个列，那么我粘贴em的工作表应该是代码在A列上找到的第一列，然后是代码在B列上找到的第二列......依此类推。 / p>

到目前为止我做了什么：

Sub bydepartment_Click()

    Dim value1 As Variant
    value1 = InputBox("Find the column by department.", "Report by department")
    If value1 = Empty Then
        Exit Sub
    End If

    Dim Found As Range, LastRow As Long
    Dim ColoanaToAdd As String
    Dim emptyOne As String
    Dim destination As Worksheet
    Dim emptyColumn As String
    Dim var As String
    Dim Coloana As String

    With Worksheets("DAT").Range("A1:QUY1")

    Sheets(value1).Cells.Clear

    Set Found = Sheets("DAT").Rows(5).Find(What:=value1, LookIn:=xlValues, LookAt:=xlWhole)
    If Not Found Is Nothing Then
            firstAddress = Found.Address
        Do

    LastRow = Cells(Rows.Count, Found.Column).End(xlUp).Row

    Select Case Found.Column
        Case 1
        Coloana = "A"
        Case 2
        Coloana = "B"
        Case 3
        Coloana = "C"
        Case 4
        Coloana = "D"
        Case 5
        Coloana = "E"
        Case 6
        Coloana = "F"
        Case 7
        Coloana = "G"
        Case 8
        Coloana = "H"
        Case 9
        Coloana = "I"
        Case 10
        Coloana = "J"
        Case 11
        Coloana = "K"
        Case 13
        Coloana = "L"
        Case 14
        Coloana = "M"
        Case 15
        Coloana = "N"
        Case 16
        Coloana = "O"
        Case 17
        Coloana = "P"
    End Select

    Set destination = Sheets(value1)
    emptyColumn = destination.Cells(5, destination.Columns.Count).End(xlToLeft).Column + 1

    If emptyColumn > 1 Then
        emptyColumn = emptyColumn
    End If

    Select Case emptyColumn
        Case 1
        var = "A"
        Case 2
        var = "B"
        Case 3
        var = "C"
        Case 4
        var = "D"
        Case 5
        var = "E"
        Case 6
        var = "F"
        Case 7
        var = "G"
        Case 8
        var = "H"
        Case 9
        var = "I"
        Case 10
        var = "J"
        Case 11
        var = "K"
        Case 13
        var = "L"
        Case 14
        var = "M"
        Case 15
        var = "N"
        Case 16
        var = "O"
        Case 17
        var = "P"
    End Select

    emptyOne = var & 1 & ":" & var

    ColoanaToAdd = Coloana & 1 & ":" & Coloana

    Sheets(value1).Range(emptyOne & LastRow).Value = Sheets("DAT").Range(ColoanaToAdd & LastRow).Value

    MsgBox "Your report was created"

    Set Found = Sheets("DAT").Rows(5).FindNext(Found)
        Loop While Not Found Is Nothing And Found.Address <> firstAddress
    End If
   End With

End Sub

我用几列的案例进行了硬编码......我知道:(但我猜，我知道有更好的方法可以做到这一点......

先谢谢你们！

Answer 1

这可能对您有所帮助。代码在 Sheet1 的第7行中查找某些值（幸福）。如果找到，那么 Sheet1 中的整个列将被复制到 Sheet2 。

代码循环遍历 Sheet1

的第7行中的所有单元格

Sub OzZie()
    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim K As Long, i As Long, nRow As Long
    Dim valuee1 As Variant

    Set sh1 = Sheets("Sheet1")
    Set sh2 = Sheets("Sheet2")
    K = 1
    nRow = 7
    valuee1 = "happiness"

    For i = 1 To Columns.Count
        If sh1.Cells(nRow, i).Value = valuee1 Then
            sh1.Cells(nRow, i).EntireColumn.Copy sh2.Cells(1, K)
            K = K + 1
        End If
    Next i
End Sub

Answer 2

试试这个代码@ozZie。这包括公式和区分大小写的问题

Sub CopynPasteColumns()
 Dim sh1 As Worksheet, sh2 As Worksheet
 Dim K As Long, i As Long, nRow As Long
 Dim valuee1 As Variant

 Set sh1 = Sheets("Sheet1")
 Set sh2 = Sheets("Sheet2")
 K = 1
 nRow = 7
 valuee1 = InputBox("Find the column by department.", "Report by department")

 For i = 1 To sh1.UsedRange.Columns.Count
     If LCase(sh1.Cells(nRow, i).Value) = LCase(valuee1) Then
         sh1.Cells(nRow, i).EntireColumn.Copy
         sh2.Cells(1, K).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
         K = K + 1
     End If
 Next i
End Sub

在特定行上搜索值，将整列复制到另一个工作表

2 个答案: