将 userforum-textbox 中的粘贴行格式化为串联或边界线？

Question

我在这一行中收到不匹配错误：

row_str = Join(cell_rng, Chr(10))

谢谢。我是中级。

我在下面附上一段代码：

    Dim last_row As String
    Dim last_col As String
    Dim office_str As String
    Dim lookupVal As String
    Dim i As Long
    Dim seperate_cells, cell_rng As Range
    Dim r As Range
    Dim row_str As String        


With Contacts
    For i = 2 To last_row
        Set cell_rng = Rows(i & ":" & i + 1)
        For Each r In cell_rng.Rows
           seperate_cells = cellsSeparator(r.SpecialCells(xlCellTypeConstants))
           If row_str = "" Then
            row_str = Join(cell_rng, Chr(10))
           Else
            row_str = row_str & vbLf & Join(cell_rng, Chr(10))
           End If
        Next
        Debug.Print row_str
        Client_Finder.result.Text = Client_Finder.result.Text & vbLf & row_str
    Next i       
End With
````

Answer 1

请尝试下一种方式。它将在文本框中放置必要的特定行的值，每个值由“|”分隔：

Sub testSeparatorsBetweenRowCells()
 'your existing code...
 Dim arr, rngR As Range
  For i = 2 To last_row
            lookupVal = cells(i, office_str)
            ' Compare ComboBox with the range from the spreadsheet
            If lookupVal = Office_Code Then
                Set rngR = rows(i & ":" & i).SpecialCells(xlCellTypeConstants) 'Set a range which will return all cells value in the row, except the empty ones
                arr = arrCells(rngR)  'call a function able to make an array from the range set in the above line
                Client_Finder.result.Text = Client_Finder.result.Text & vbLf & Join(arr, " | ") 'add the text obtained by joining the array to the next line of existing text
            End If
    Next i
End Sub

Function arrCells(rng As Range) As Variant
   Dim arr, Ar As Range, i As Long, C As Range
   ReDim arr(rng.cells.count - 1) 'ReDim the array to be filled as the range cells number.
                                           '- 1, because the array is 0 based...
   For Each Ar In rng.Areas       'iterate between the range areas
        For Each C In Ar.cells      'iterate between cells of each area
            arr(i) = C.value: i = i + 1 'put each cell value in the array
        Next
   Next
   arrCells = arr                      'make the function returning the arr
End Function

如果文本框中的文本仍然在下一行，请尝试将文本框设为属性 WordWrap False。如果您看不到所有文本，请加宽文本框或减小其字体大小。

请测试并发送一些反馈。

已编辑：请尝试理解下一段代码，能够一次复制更多行：

Sub testCopyingMoreRows()
   Dim sh As Worksheet, i As Long, rng As Range, r As Range, arr, strRow As String
   
   Set sh = ActiveSheet
   i = 9
   Set rng = sh.rows(i & ":" & i + 1)
   'you ca select cells, rows (even not consecutive) and use:
   'Set rng = Selection.EntireRow 'just uncomment this code line...
   'extract rows and paste their contents (exept the empty cells) in Imediate Window
   For Each r In rng.rows
        arr = arrCells(r.SpecialCells(xlCellTypeConstants))
        If strRow = "" Then
            strRow = Join(arr, " | ")
        Else
            strRow = strRow & vbLf & Join(arr, " | ")
        End If
   Next
   Debug.Print strRow
   'instead returning in Imediate Window, you can do it in your text box (uncomment the next line):
   'Client_Finder.result.Text = Client_Finder.result.Text & vbLf & strRow
End Sub

代码使用相同的函数arrCells...

将 userforum-textbox 中的粘贴行格式化为串联或边界线？

Format pasted rows within userforum-textbox into concatenation or borderline?

vba

border

userform