基于多个输入的Excel VBA查找的VBA代码(部分)

时间:2014-07-31 04:04:47

标签: excel-vba vba excel

我的Excel表格格式与此类似

Name code1  Name Code2  Name       Number    Input1   Input2   
AB           XY        GSABPEXY1    110      BA       BC
BC           BA        GSBCPEBA1    120
CD           CA        GSCDPECA1    13
DC           DA        GSDCPEDA3    140
BC           BA        GSBCPEBA3    15

问题:

  1. 我想通过匹配Input1和Input2中的输入来获取Name列中的值。
  2. 我需要将这些匹配的值粘贴到另一张预定义的特定行和列单元格中
  3. 使用excel函数countifs我计算列A(名称代码1)和B(名称代码2)中具有相同重复值的行数,例如在BC和BA之上,计数为2。
  4. 我想将此值(在#3中提到)用于循环迭代
  5. 我得到的代码看起来非常接近,但它缺少两个在INSTR函数中预定义ABC的东西,它没有AND运算符 - 我不知道该怎么做。我对VBA很新,所以请原谅我,如果我遗漏了一些简单和/或提供较少信息的话。

    代码:

    Sub Hostname()
        Dim K As Long, r As Range, v As Variant
        K = 1
        Dim w1 As Worksheet, w2 As Worksheet
        Set w1 = Sheets("Sheet2")
        Set w2 = Sheets("Sheet3")
        w1.Activate
        For Each r In Intersect(Range("A:A"), ActiveSheet.UsedRange)
            v = r.Value
            If InStr(v, "ABC") > 0 Then
                r.Copy w2.Cells(K, 1)
                K = K + 1
            End If
        Next r
    End Sub
    

1 个答案:

答案 0 :(得分:0)

好的,我想我明白了你想做什么。怎么样?

Sub Hostname()

    Dim codeName1 As String
    Dim codeName2 as string
    Dim count As Integer
    Dim r As Range
    Dim targetRange as Range

    Set targetSheet = ThisWorkbook.Sheets("MyTargetSheetName").Range("AddressOfFirstCellForDataInput")
    codeName1 = "BC"
    codeName2 = "BA"

    For Each r In ActiveSheet.Range("A:A")
        with r
            If .Value2 = codeName1 And .Offset(0, 1).Value2 = codeName2 Then
                targetRange.Offset(count, 0).value = .Offset(0, 2).Value2
                count = count + 1
            ElseIf Len(Trim(.Value2)) = 0 Then
                Exit For
            end if
        End With
    Next

    Call msgbox("Found " & count & "cells matching Name code 1: " & codeName1 & " Name code 2: " & codeName2)
End Sub

这将计算与名称代码1和名称代码2相匹配的单元格数量。您是否可以根据需要对其进行调整?