vba Excel 宏 - 将多列合并为一
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/3979194/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Excel Macro - combine Multiple Columns Into One
提问by Muamar
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:
我有一个 2007 年的 excel 工作表，有 12 列（每列对应一个月），每列包括 +/-30000 行的日降雨量数据。我需要做的是将这些数据列组合成一个新列（一个连续降雨系列），如下所示：
Copy the first 31 (the number of days of January) rows “A1:A31” from column 1 to the new column
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]
Then, do the same for the next year, i.e. copy the second 31 values “A32:A62” from column 1 and place it beneath the previous year (Step 1 & 2) in the new column.
- In total, the result will be a continuous daily rainfall series.
将前 31（一月的天数）行“A1:A31”从第 1 列复制到新列
复制第 2 列的前 28（二月的天数）行，并将其放在新列中先前值的下方，等等......。[第3列的前31行（三月），第4列的30，第5列的31，第6列的30，第7列的31，第8列的31，第9列的30，第10列的31，第30列来自第 12 列的 11 和 31]
然后，对下一年执行相同的操作，即从第 1 列复制后 31 个值“A32:A62”并将其放在新列中前一年（步骤 1 和 2）的下方。
- 总的来说，结果将是一个连续的每日降雨系列。
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 1 25 15
1990 2 20 12
1990 2 20 12
1990 3 22
1990 3 22
1990 4 26
1990 4 26
So every column has a different length from month to month according to the number of days in each month (e.g., January has 31 days). Now, I need to combine all the entries into one long column. So it would look like this:
因此，根据每个月的天数（例如，1 月有 31 天），每个月的每一列都有不同的长度。现在，我需要将所有条目合并到一个长列中。所以它看起来像这样：
25
25
20
20
22
22
26
26
15
15
12
12
Any help would be appreciated!
任何帮助，将不胜感激！
回答by ArBR
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
回答by ArBR
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
