Excel 范围到 CSVrangeoutput - 将范围分成 41 个条目的组

Excel Range to CSVrangeoutput - split range into groups of 41 entries

我不确定如何在 google 搜索中解释这个问题,所以我不确定是否有其他人问过这个问题。

我有一个 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。

像这样:

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

请测试下一个代码。对于列 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:A 列的最后一个单元格。如果经过测试,代码被证明是可靠的,不需要再运行一次,Set rngStart = sh.Range("B" & UBound(arr) + 2)可以在Set rngStart = sh.Range("A" & UBound(arr) + 2).

中修改

如果没有初步格式化为文本,数据将被删除的区域,Excel 更改“科学”中的 NumberFormat,当逗号分隔的字符串包含(仅)每个三位数的数字时.它看起来将逗号视为千位分隔符...