Excel宏-将多列合并为一个

Question

I have an excel 2007 worksheet with 12 columns (each column is corresponding to a month) and every column includes +/-30000 rows of daily rainfall data. What I need to do is combine these columns of data into one new column (one continuous rainfall series) as follows:

1. Copy the first 31 (the number of days of January) rows “A1:A31” from column 1 to the new column

2. Copy the first 28 (the number of days of February) rows from column 2 and place it beneath the previous values in the new column, and, etc.…. [The first 31 rows (March) from column 3, 30 from column 4, 31 from column 5, 30 from column 6, 31 from column 7, 31 from column 8, 30 from column 9, 31 from column 10, 30 from column 11 and 31 from column 12]

3. Then, do the same for the next year, ie copy the second 31 values “A32:A62” from column 1 and place it beneath the previous year (Step 1 & 2) in the new column.

4. In total, the result will be a continuous daily rainfall series.

I have tried my best to accomplish this, but I have got nowhere!

Please, could someone help me with this?

Thanks a lot

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

More explanation

The data are sorted into several columns by month, for several years, and it looks something like this:

Year Day Jan Feb March

1990 1 25 15

1990 2 20 12

1990 3 22

1990 4 26

So every column has a different length from month to month according to the number of days in each month (eg, January has 31 days). Now, I need to combine all the entries into one long column. So it would look like this:

25

20

22

26

15

12

Any help would be appreciated!

Answer 1

Also the following methods could be helpful for you:

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

If what you want is to merge cells you should create a Macro and the use a function to achieve such task. Try this code:

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