将数组写入单元格

代码find一个范围内的第一个和最后一个sting，然后构build一个数组。 我的问题是我不知道如何将数组写入到工作表的逗号分隔格式的单元格。 .Find从范围的起始处开始search，然后从范围的结尾search。 都停在searchvariables的第一次出现。

问题：1.如何提高代码的速度，因为这将在100,000+行范围内search范围2.如何将创build的数组写入工作表中的逗号分隔string。

Public Function FindVehicleOptions() Dim LastRow As Long Dim vArr As Variant Dim FindString As String Dim Rng1 As Range Dim Rng2 As Range Dim CellAddress As String Dim Cell As Range Dim Search As String Dim NumRows As Long Dim NumCols As Long Dim Key As String Dim i As Integer Dim j As Integer Dim x As Integer Dim s As String Dim wb1 As Excel.Workbook: Set wb1 = Application.Workbooks("AFS Configuration Ver 2.xlsm") Dim ws1 As Worksheet: Set ws1 = Sheets("Configuration") Dim Destination As Range Dim sDelimString As String Dim lCounter As Long FindString = Sheets("AFS Report").Range("A3") If Trim(FindString) <> "" Then With ws1.Range("B:B") Set Rng1 = .Find(What:=FindString, After:=.Cells(.Cells.Count), LookIn:=xlValues, LookAt:=xlWhole, _ SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) If Not Rng1 Is Nothing Then Application.Goto Rng1, True Debug.Print Rng1.Address Else Debug.Print "Nothing found" End If End With End If If Trim(FindString) <> "" Then With ws1.Range("B:B") Set Rng2 = .Find(What:=FindString, After:=.Cells(1), LookIn:=xlValues, LookAt:=xlWhole, _ SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False) If Not Rng2 Is Nothing Then Application.Goto Rng2, True Debug.Print Rng2.Address CellAddress = Rng2.Address Set Cell = Range(CellAddress) Else Debug.Print "Nothing found" End If End With End If vArr = ws1.Range(Rng1.Address & ":" & Rng2.Offset(0, 5).Address).Value Debug.Print "New value of " & Rng1.Address & Rng2.Offset(0, 5).Address NumRows = UBound(vArr, 1) - LBound(vArr, 1) + 1 NumCols = UBound(vArr, 2) - LBound(vArr, 2) + 1 Set Destination = Range("B3") Destination.Resize(UBound(vArr, 2), UBound(vArr, 1)).Value = Application.Transpose(vArr) End Function 

Answer 1

下面是以csv格式将二维数组放入单个单元格的一个典型示例：

 Sub dural() Dim vArray(1 To 3, 1 To 5) As Long, K As Long Dim rDestination As Range, sTringg As String Set rDestination = Range("B9") K = 1 For i = 1 To 3 For j = 1 To 5 vArray(i, j) = K K = K + 1 Next j Next i sTringg = "" For i = LBound(vArray, 1) To UBound(vArray, 1) For j = LBound(vArray, 2) To UBound(vArray, 2) sTringg = sTringg & "," & vArray(i, j) Next j Next i sTringg = Mid(sTringg, 2, Len(sTringg) - 1) rDestination = sTringg End Sub