배열을 셀에 쓰기

Question

코드는 범위에서 스팅의 첫 번째와 마지막 발생을 찾은 다음 배열을 만듭니다. 내 문제는 어떻게 셀에 쉼표로 구분 된 형식으로 워크 시트에 배열을 작성할지 모르겠습니다. .Find는 범위의 시작 부분부터 검색하고 두 번째 .Find는 범위 끝에서부터 검색합니다. 둘 다 검색 변수의 첫 x 째 항목에서 중지합니다.

Questions : 1. 100,000+ 행 범위의 범위를 검색 할 때 속도를 향상시키는 방법 2. 작성된 배열을 워크 시트의 쉼표로 구분 된 문자열에 쓰는 방법.

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