首页 > 解决方案 > 将两个范围按行连接为一个

问题描述

所以我目前正在为我的项目在 VBA 中查找值方法。现在手头的问题是弄清楚如何将两个相同大小的范围连接成一个。例如,我有一个包含客户名字和第二个客户姓氏的范围,其想法是,如果该人使用应用程序按名字和姓氏搜索客户,那么我可以使用一个搜索值作为名字 + 姓氏并搜索一个 Range,其中 Range_1 with First names 与 Range_2 with Last names 连接。我已经编写了适用于一个搜索值和一个查找范围的 Find 方法,但是如果有人可以提供一个简单的示例来说明如何按行将两个范围连接在一起,那将非常有帮助。

您可以在下面看到我当前的查找方法,该方法效果很好。我也是初学者,所以我也在寻找关于如何改进我的代码的建议。

Sub SearchScenarioVar_1()

'The search Value'
Dim Var As String

'Search Range'
Dim RangeVar As Range

'Each Variable (total 3 variables) have been assigned one prime number (1, 3, 5),'
'SumOfVar represents sum value of filled in variables,'
'thus the filled in fields are known.'
Dim SumOfVar As String

'Based on value SumOfVar, X is 1, 2 Or 3'
Dim X As String

'XCol is column from Data table'
Dim XCol As Long

'LastRow is row from Data table'
Dim LastRow As Long

'XRow is row from variables'
Dim XRow As Long


'Used in Find method'
Dim FoundCell As Range
Dim FirstFoundCellAddress As String
Dim Found As String

'For displaying results'
Dim DataRow As Long

Application.ScreenUpdating = False

'To clear fields where results will be displayed'
ClearInputCells3_1

'SumOfVar value fetched from app workbook'
SumOfVar = Workbooks("main_admin.xlsm").Sheets("main_admin").Range("C43").Value

'Assign X the value from 1 - 3 to know which search variable and search range to use in find method'
'1 & 2 are First and Last name, 3 is Social security number'
If SumOfVar = 1 Then
    X = 1
Else
    If SumOfVar = 3 Then
        X = 2
    Else
        If SumOfVar = 5 Or 6 Or 8 Or 9 Then
            X = 3
        Else
            Exit Sub
        End If
    End If
End If
    
'Function to open the data table'
OpenDBclient
    
'Find last row in data table'
LastRow = Workbooks("main_data.xlsx").Sheets("data").Cells(Rows.Count, "A").End(xlUp).Row

'Sets column and Row value for Find method'
XCol = 1 + X
XRow = 43 + X

'Fetches search value'
Var = Workbooks("main_admin.xlsm").Sheets("main_admin").Cells(XRow, 2).Value

'Sets search range'
Set RangeVar = Workbooks("main_data.xlsx").Sheets("data").Range(Cells(2, XCol), Cells(LastRow, XCol))

'DataRow is the First row where values will be displayed'
DataRow = 37

'Find Method starts'
With RangeVar
    Set FoundCell = .Find(What:=Var, After:=.Cells(.Cells.Count), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
End With

If Not FoundCell Is Nothing Then
    FirstFoundCellAddress = FoundCell.Address
    Do
    'Writes values from data table to app displayed area'
    
    Found = Workbooks("main_data.xlsx").Sheets("data").Cells(FoundCell.Row, 1).Value
    Workbooks("main_admin.xlsm").Sheets("main_admin").Cells(DataRow, 87).Value = Found
    
    Found = Workbooks("main_data.xlsx").Sheets("data").Cells(FoundCell.Row, 2).Value
    Workbooks("main_admin.xlsm").Sheets("main_admin").Cells(DataRow, 63).Value = Found
    
    Found = Workbooks("main_data.xlsx").Sheets("data").Cells(FoundCell.Row, 3).Value
    Workbooks("main_admin.xlsm").Sheets("main_admin").Cells(DataRow, 69).Value = Found
    
    Found = Workbooks("main_data.xlsx").Sheets("data").Cells(FoundCell.Row, 4).Value
    Workbooks("main_admin.xlsm").Sheets("main_admin").Cells(DataRow, 75).Value = Found
    
    'Sets next row'
    DataRow = DataRow + 1
    
    Set FoundCell = RangeVar.FindNext(After:=FoundCell)
    
    'Sets limit to stop when the search has gone full circle or max row is reached'
Loop Until FoundCell.Address = FirstFoundCellAddress Or DataRow = 46
End If

'Closes data table'
CloseDBclient

Application.ScreenUpdating = True
End Sub

标签: excelvba

解决方案


推荐阅读