Excel宏 - 将多个列合并为一个

Question

我有一个包含12列的excel 2007工作表（每列对应一个月），每列包含+/- 30000行每日降雨量数据。我需要做的是将这些数据列组合成一个新列（一个连续降雨系列），如下所示：

1. 将第1列（1月份的天数）行“A1：A31”从第1列复制到新列

2. 从第2列复制前28行（2月的天数）行，并将其放在新列中的先前值之下，等等.... [第3列的前31行（3月），第4列30，第5列31，第6列31，第7列31，第8列31，第9列30，第10列31，第10列）第12栏中的11和31]

3. 然后，对下一年做同样的事情，即从第1列复制第二个31个值“A32：A62”，并将它放在新列中的上一年（步骤1和2）之下。 / p>

4. 总的来说，结果将是连续的每日降雨量系列。

我尽力做到这一点，但我无处可去！

拜托，有人可以帮我吗？

非常感谢

==================

更多解释

数据按月分为几列，持续数年，看起来像这样：

1月2月1月的一年

1990 1 25 15

1990 2 20 12

1990 3 22

1990 4 26

因此，根据每个月的天数（例如，1月份为31天），每个列的长度与月份不同。现在，我需要将所有条目组合成一个长列。所以它看起来像这样：

25

20

22

26

15

12

任何帮助将不胜感激！

Answer 1

以下方法也可能对您有所帮助：

Function xlsRangeCopyConditionalFormat(ByRef r1 As Excel.Range, _
                                       ByRef r2 As Excel.Range)
    Dim i As Integer
    For i = 1 To r1.FormatConditions.Count
        r2.FormatConditions.Delete
    Next    
    For i = 1 To r1.FormatConditions.Count
            r2.FormatConditions.Add _
                                type:=r1.FormatConditions(i).type, _
                                Operator:=r1.FormatConditions(i).Operator, _
                                Formula1:=r1.FormatConditions(i).Formula1

        xlsRangeCopyFont r1.FormatConditions(i).Font, r2.FormatConditions(i).Font
        xlsRangeCopyInterior r1.FormatConditions(i).Interior, r2.FormatConditions(i).Interior        
    Next
End Function

Public Function xlsRangeCopyInterior(ByRef i1 As Excel.Interior, _
                                     ByRef i2 As Excel.Interior)
    With i2
        .Pattern = i1.Pattern
        .ColorIndex = i1.ColorIndex
    End With
End Function

Public Sub xlsRepeatValueInCell(ByRef xlSheet As Excel.Worksheet, _
                             ByRef sColumn As String, _
                             ByVal irow As Integer, _
                             ByRef sValue As String)                              
    xlsSetValueInCell xlSheet, sColumn, irow, sValue
    xlSheet.Range(sfxls_RA1(sColumn, irow)).Borders(xlEdgeTop).color = RGB(255, 255, 255)
    xlSheet.Range(sfxls_RA1(sColumn, irow)).Font.ColorIndex = 15
End Sub

Public Sub xlsSetCellInterior(ByRef xlSheet As Excel.Worksheet, _
                              ByRef sColumn As String, _
                              ByRef irow As Integer, _
                              ByRef iColorIndex As Integer, _
                              Optional ByRef bSetCellValue As Boolean = False, _
                              Optional ByRef iCellValueColor = Null)
    ' Set cells interior based on the passed arguments

    Dim iPattern As Integer, iColorIndex As Integer, sValue As String

    iPattern = xlSolid 'iPattern = xlGray16
    xlSheet.Range(sfxls_RA1(sColumn, irow)).Interior.Pattern = iPattern
    xlSheet.Range(sfxls_RA1(sColumn, irow)).Interior.ColorIndex = iColorIndex
    If bSetCellValue = True Then
        xlSheet.Range(sfxls_RA1(sColumn, irow)).FormulaR1C1 = sValue
    End If
    If Not IsNull(iCellValueColor) Then
        xlSheet.Range(sfxls_RA1(sColumn, irow)).Font.ColorIndex = iCellValueColor
    Else
        xlSheet.Range(sfxls_RA1(sColumn, irow)).Font.ColorIndex = iColorIndex
    End If

End Sub

Answer 2

如果你想要的是合并单元格，你应该创建一个宏并使用一个函数来实现这样的任务。试试这段代码：

Public Sub xlsSetMsgAndCombineCells(xlSheet As Excel.Worksheet, _
                                  sCol1 As String, _
                                  sCol2 As String, _
                                  irow As Integer, _
                                  sValue As String)
    ' Combine specified cells and set a message

    Dim xlRange As Excel.Range
    Set xlRange = xlSheet.Range(sfxls_RA1(sCol1, irow), sfxls_RA1(sCol2, irow))

    With xlRange
        .Merge
        .FormulaR1C1 = sValue
        .Font.Bold = True
        .VerticalAlignment = xlVAlignCenter
        .HorizontalAlignment = xlVAlignCenter
    End With

    Set xlRange = Nothing

End Sub