Excel 范围到 CSVrange 输出 - 将范围分成 41 个条目的组

Question

我不确定如何在谷歌搜索中解释这个问题，所以我不确定是否有人问过这个问题。

我有一个 vba 函数，它接受一个范围并将其转换为逗号分隔值的字符串。 它就像一个魅力。

现在我希望它只输出前 41 个条目，向下切换一行并输出该范围内的下 41 个条目。

我无法完全理解它，感觉就像一个简单的循环，但我无法到达那里。

我在网上某处找到了 csvrange 宏 :)

Function csvRange(myRange As Range)    
    Dim csvRangeOutput
    Dim entry As Variant    
    For Each entry In myRange    
        If Not IsEmpty(entry.Value) Then
            csvRangeOutput = csvRangeOutput & entry.Value & ","
        End If   
    Next
    csvRange = Left(csvRangeOutput, Len(csvRangeOutput) - 1)
End Function

输入范围如下所示

所需的输出看起来像这样，一个字符串位于 B 列中，每组 41 个值在一行上分隔，每次函数到达下一个 nr 42 时向下偏移 1。

Answer 1

类似这样的：

Option Explicit

Public Sub test()

    Debug.Print csvRange(Selection, 41)

End Sub

Public Function csvRange(ByVal myRange As Range, ByVal Columns As Long) As String
    Dim csvRangeOutput
    Dim iCol As Long

    Dim Entry As Variant
    For Each Entry In myRange
        If Not IsEmpty(Entry.Value) Then
            iCol = iCol + 1
            csvRangeOutput = csvRangeOutput & Entry.Value
    
            If iCol = Columns Then
                csvRangeOutput = csvRangeOutput & vbCrLf
                iCol = 0
            Else
                csvRangeOutput = csvRangeOutput & ","
            End If
        End If
    Next
    
    csvRange = Left$(csvRangeOutput, Len(csvRangeOutput) - 1)
End Function

会转这个数据

41 列的逗号分隔值

1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41
42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82
83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,123
124,125,126,127,128,129,130,131,132,133,134,135,136,137,138,139,140

另类

Public Sub Convert()
    Const ColCount As Long = 41
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    Dim LastRow As Long
    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    Dim iRow As Long
    For iRow = 1 To LastRow Step ColCount
        ws.Cells(iRow \ ColCount + 1, "B").Value = "'" & Join((WorksheetFunction.Transpose(ws.Range("A" & iRow).Resize(RowSize:=IIf(iRow + ColCount - 1 > LastRow, WorksheetFunction.Max(LastRow Mod ColCount, 2), ColCount)).Value)), ",")
    Next iRow
End Sub

Answer 2

请测试下一个代码。它会做你需要的（我理解），因为你在 A:A 列中有尽可能多的记录。它应该很快，使用数组并在内存中工作。单次迭代是针对必要数量的范围切片：

Private Sub testStringCSVArray()
  Dim sh As Worksheet, arr, nrSlices As Long, LastRow As Long, rngF As Range
  Dim rngStart As Range, i As Long, k As Long, h As Long, arrFin
  
  Set sh = ActiveSheet
  LastRow = sh.Range("A1").End(xlDown).row
  LastRow = sh.Range("A" & rows.count).End(xlUp).row 'last row of A:A
  arr = sh.Range("A1:A" & LastRow).Value             'put the range in an array

  nrSlices = UBound(arr) \ 41                    'determine the number of necessary slices
  ReDim arrFin(nrSlices + 1)
  Set rngStart = sh.Range("B" & UBound(arr) + 2) 'set the cell where the result to be returned
  For i = 1 To nrSlices + 1
      arrFin(h) = CStr(Join(Application.Transpose(Application.Index(arr, _
             Evaluate("row(" & k + 1 & ":" & IIf(i <= nrSlices, 41 + k, UBound(arr)) & ")"), 1)), ","))
     k = k + 41: h = h + 1
  Next i
  'Format the range where the processed data will be returned and drop the processed data array:
  With rngStart.Resize(h, 1)
      .NumberFormat = "@"
      .Value = WorksheetFunction.Transpose(arrFin)
  End With
End Sub

为了避免删除已经处理的数据，如果希望运行代码两次或更多次，处理后的数据将在B列中返回：B列，从A列最后一个单元格向下两行：一种。如果经过测试，代码可靠，不需要再运行一次，Set rngStart = sh.Range("B" & UBound(arr) + 2)可以在Set rngStart = sh.Range("A" & UBound(arr) + 2)中修改。

如果将删除数据的区域初步​​格式化为文本，Excel 会更改“科学”中的 NumberFormat，此时逗号分隔的字符串（仅）包含三个数字的数字。它看起来将逗号视为千位分隔符...