Макрос Excel - объедините несколько столбцов в один

Question

У меня есть лист Excel 2007 с 12 столбцами (каждый столбец соответствует месяцу), и каждый столбец содержит +/- 30000 строк данных о суточных осадках.Что мне нужно сделать, так это объединить эти столбцы данных в один новый столбец (один непрерывный ряд осадков) следующим образом:

1. Скопировать первые 31 (число дней января) строк «A1: A31 ”из столбца 1 в новый столбец

2. Скопируйте первые 28 (число дней февраля) строк из столбца 2 и поместите его под предыдущими значениями в новом столбце, и так далее.….[Первые 31 строка (март) из столбца 3, 30 из столбца 4, 31 из столбца 5, 30 из столбца 6, 31 из столбца 7, 31 из столбца 8, 30 из столбца 9, 31 из столбца 10, 30 из столбца11 и 31 из столбца 12]

3. Затем сделайте то же самое для следующего года, т.е. скопируйте вторые 31 значение «A32: A62» из столбца 1 и поместите его под предыдущий год(Шаг 1 и 2) в новом столбце.

4. В итоге результатом будет непрерывная серия ежедневных дождевых осадков.

Я изо всех сил старался добиться этого, но я никуда не попал!

Пожалуйста, кто-нибудь может мне помочь с этим?

Большое спасибо

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

Дополнительные пояснения

Данныесортируется по нескольким столбцам по месяцам, в течение нескольких лет, и выглядит примерно так:

Год День Янв Фев Март

1990 1 25 15

1990 2 20 12

1990 3 22 * ​​1037 *

1990 4 26

Таким образом, каждый столбец имеет разную длину от месяца к месяцу в зависимости от количества дней в каждом месяце (например, в январе 31 день).Теперь мне нужно объединить все записи в один длинный столбец.Так это будет выглядеть так:

25

20

22 * ​​1047 *

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