我想将值从列 B、C、D 复制到列 J，同时保持值的行位置。
我想将值从 E、F、G 列复制到 K 列，同时保持行位置。
Desired results in Cols J & K. The colors are only to clarify my objective.
行数每周将在 30 到 80 行之间波动，并有新值。
有时数据中会存在间隙，如第 34 行...C 列第 34 行为空白。这必须反映在 J 上校中。我用边框勾勒出这些单元格，以证明存在数据漏洞。如果单元格为空白，我不需要设置边框格式。
I would like使用 Col A 作为我的行计数，因为 Col A 将始终确定有多少行将包含接下来 6 列的值。换句话说，工作表的最后一个值将始终与 A 列中的最后一个值位于同一行，但下周它们可能不在 C 和 F 列中。如果 B 至 G 列中的任意列中有值，则 A 列中始终有一个值。
我尝试为每个列 B、C、D、E、F、G、J 和 K 创建单独的声明范围，但复制函数不会将数据保留在原始行中。
我尝试创建组合列 A、B、C 和列 E、F、G 的声明范围，但我的复制函数并未将数据合并为 2 个不同的列。
以下公式调整为下面的截图。
在 Excel 中你可以这样做：
=TOCOL(B2:D11,1)
其中排除空单元格。
为了安全起见并排除所有空白单元格，您可以使用以下之一：
=LET(c,TOCOL(B2:D11),FILTER(c,c<>""))
=TOCOL(IF(B2:D11<>"",B2:D11,NA()),3)
如果您没有 Microsoft 365，您可以使用下面的 VBA 函数，如下所示：
=RangeToCol(B2:D11,1)
截图
B2:D11.=""而且从具有此类单元格的范围复制数据并粘贴值时也是如此。TOCOL不认为它们是空白的，或者正如我所说，当第二个参数设置为 1 时，它仅排除空单元格（它们是空白单元格的一部分）。看专栏G在屏幕截图中（ignore=1).ISBLANK实际上返回TRUE仅适用于空单元格，就像COUNTA计算所有非空单元格。COUNTBLANK“理解”空白单元格是什么。调用过程
Sub CopyToSingleColumns()
Const SRC_SHEET As String = "Sheet1"
Const SRC_FIRST_CELL As String = "A2"
Dim sCols(): sCols = VBA.Array("B:D", "E:G")
Const DST_SHEET As String = "Sheet1"
Dim dfCells(): dfCells = VBA.Array("J2", "K2")
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim sws As Worksheet: Set sws = wb.Sheets(SRC_SHEET)
Dim srg As Range
With sws.Range(SRC_FIRST_CELL)
Set srg = sws.Range( _
.Cells, sws.Cells(sws.Rows.Count, .Column).End(xlUp))
End With
Dim dws As Worksheet: Set dws = wb.Sheets(DST_SHEET)
Dim sData(), n As Long
For n = 0 To UBound(sCols)
sData = RangeToCol(srg.EntireRow.Columns(sCols(n)), 1)
dws.Range(dfCells(n)).Resize(UBound(sData)).Value = sData
Next n
MsgBox "Values copied to single columns.", vbInformation
End Sub
主要功能
RangeToRow， 可以被找寻到here https://stackoverflow.com/a/75809065.Function RangeToCol( _
ByVal rg As Range, _
Optional ByVal Ignore As Long = 0, _
Optional ByVal ScanByColumn As Boolean = False) _
As Variant
Dim srCount As Long: srCount = rg.Rows.Count
Dim scCount As Long: scCount = rg.Columns.Count
Dim drCount As Long: drCount = srCount * scCount
Dim sData()
If drCount = 1 Then
ReDim sData(1 To 1, 1 To 1): sData(1, 1) = rg.Value
Else
sData = rg.Value
End If
Dim dArr(): ReDim dArr(1 To drCount)
Dim sVal, sr As Long, sc As Long, dr As Long
If ScanByColumn Then
For sc = 1 To scCount
For sr = 1 To srCount
If IsErrorBlankTestPassed(sData(sr, sc), Ignore) Then
dr = dr + 1
dArr(dr) = sData(sr, sc)
End If
Next sr
Next sc
Else
For sr = 1 To srCount
For sc = 1 To scCount
If IsErrorBlankTestPassed(sData(sr, sc), Ignore) Then
dr = dr + 1
dArr(dr) = sData(sr, sc)
End If
Next sc
Next sr
End If
If drCount = 0 Then Exit Function ' only blanks and/or errors
Dim dData(): ReDim dData(1 To dr, 1 To 1)
For dr = 1 To dr
dData(dr, 1) = dArr(dr)
Next dr
RangeToCol = dData
End Function
辅助函数
Function IsErrorBlankTestPassed( _
ByVal Value As Variant, _
ByVal Ignore As Long) _
As Boolean
Dim IsAddable As Boolean
Select Case Ignore
Case 0: IsAddable = True ' nothing
Case 1: If Len(CStr(Value)) > 0 Then IsAddable = True ' blanks
Case 2: If Not IsError(Value) Then IsAddable = True ' errors
Case 3:
If Not IsError(Value) Then ' blanks and errors
If Len(CStr(Value)) > 0 Then IsAddable = True
End If
End Select
IsErrorBlankTestPassed = IsAddable
End Function