我以这种形式从文本文件导入原始数据：
Current table:
column1 | column2 | column3
Data | Value1 | Value2
case1_int_a | 1 | 0.76
case1_int_b | 2 | 1.24
case1_fp_x | 3 | 2.00
case1_fp_y | 4 | 3.42
case1_fp_z | 43 | 1.876
case2_int_c | 100 | 0.234
case3_int_d | 12 | 1
case3_int_e | 134 | 1.6
Desired Table:
column | column2 | column3
Data | Value1 | Value2
case1_int_a | 1 | 0.76
case1_int_b | 2 | 1.24
Geomean | = GEO(..) | =GEO(..)
Data | Value1 | Value2
case1_fp_x | 3 | 2.00
case1_fp_y | 4 | 3.42
case1_fp_z | 43 | 1.876
Geomean | = GEO(..) | =GEO(..)
Data | Value1 | Value2
case2_int_c | 100 | 0.234
case3_int_d | 12 | 1
Geomean | = GEO(..) | =GEO(..)
Data | Value1 | Value2
case3_int_e | 134 | 1.6
Geomean | = GEO(..) | =GEO(..)
我尝试使用Autofilter，但为此我需要对标准进行硬编码，因为有许多不同类型的组，应该有一些其他方式可以比较A列的前9个字符然后插入空白行。我希望问题很清楚。提前致谢
答案 0 :(得分：0)
这应该输出你想要的。不是很优雅，但应该完成工作。数据必须来自Cell A1。输出到列F到H。
Sub CleanUp()
Dim Row1(3) As String
Dim DataValue() As String
Dim ColumnNum As Integer
Dim DataRange As Range
Dim ValueValues()
Dim Partition() As Integer
ColumnNum = Application.CountA(Range("A:A")) - 1
ReDim DataValue(ColumnNum)
ReDim ValueValues(3, ColumnNum)
Set DataRange = Range("A2:A" & ColumnNum + 1)
Row1(1) = Range("A1").Value
Row1(2) = Range("B1").Value
Row1(3) = Range("C1").Value
i = 0
s = 0
'Populate arrays
ReDim Preserve Partition(1)
Partition(1) = 1
s = 1
For Each cell In DataRange.Cells
i = i + 1
DataValue(i) = Left(cell.Value, Len(cell.Value) - 2)
If i > 1 Then
If DataValue(i) <> DataValue(i - 1) Then
s = s + 1
ReDim Preserve Partition(s + 1)
Partition(s) = i
End If
End If
ValueValues(1, i) = cell.Value
ValueValues(2, i) = cell.Offset(0, 1).Value
ValueValues(3, i) = cell.Offset(0, 2).Value
Next cell
'Output
n = 0
t = -2
Partition(s + 1) = ColumnNum + 1
For m = 2 To s + 1
t = t + 3
i = 0
num = t
Cells(num, 5).Value = Row1(1)
Cells(num, 6).Value = Row1(2)
Cells(num, 7).Value = Row1(3)
For n = Partition(m - 1) To Partition(m) - 1
i = i + 1
Cells(num + i, 5).Value = ValueValues(1, n)
Cells(num + i, 6).Value = ValueValues(2, n)
Cells(num + i, 7).Value = ValueValues(3, n)
t = t + 1
Next n
Cells(t + 1, 5).Value = "Geomean"
Cells(t + 1, 6).Formula = "=GEOMEAN(F" & t - i + 1 & ":F" & t & ")"
Cells(t + 1, 7).Formula = "=GEOMEAN(G" & t - i + 1 & ":G" & t & ")"
Next m
End Sub
答案 1 :(得分：0)
即使我不喜欢原版，我也不会发布竞争对手的答案。我有一个例外，原因有两个：
如果您不确定如何完成这样的任务，请将其分解为小步骤。为步骤1编写一个宏。当它工作时，更新步骤1和2的宏。依此类推。这种方法的优点包括：
这里的第一步是识别组。宏Split1标识组并将其详细信息输出到立即窗口。对于样本数据，输出为：
Group case1_int from row 2 to 3
Group case1_fp_ from row 4 to 6
Group case2_int from row 7 to 7
Group case3_int from row 8 to 9
请注意，我的第三和第四组与您的不同。
宏Split2以Split1为基础。它将源标头和每个组复制到目标区域，并添加总计行。
Option Explicit
Sub Split1()
Dim PrefixCrnt As String
Dim RowSrcCrnt As Long
Dim RowSrcGrpStart As Long
With Worksheets("Source")
RowSrcGrpStart = 2 ' Assumes one header row
PrefixCrnt = Mid(.Cells(RowSrcGrpStart, 1).Value, 1, 9)
RowSrcCrnt = RowSrcGrpStart + 1
Do While True
If PrefixCrnt <> Mid(.Cells(RowSrcCrnt, 1).Value, 1, 9) Then
' Current group finished
Debug.Print "Group " & PrefixCrnt & " from row " & RowSrcGrpStart & " to " & RowSrcCrnt - 1
If .Cells(RowSrcCrnt, 1).Value = "" Then
Exit Do
End If
RowSrcGrpStart = RowSrcCrnt
PrefixCrnt = Mid(.Cells(RowSrcGrpStart, 1).Value, 1, 9)
RowSrcCrnt = RowSrcGrpStart + 1
Else
' Current group not finished
RowSrcCrnt = RowSrcCrnt + 1
End If
Loop
End With
End Sub
Sub Split2()
' Define number of columns as constant. I do not think this makes the code
' more complicated and it allows for any future addition of a new column
Const NumCols As Long = 3
Dim ColDestCrnt As Long
Dim ColDestStart As Long
Dim PrefixCrnt As String
Dim RngHdr As Range
Dim RngSrc As Range
Dim RowDestCrnt As Long
Dim RowDestGrpStart As Long
Dim RowDestStart As Long
Dim RowSrcCrnt As Long
Dim RowSrcGrpStart As Long
Dim WshtDest As Worksheet
' Define the start point for the output which can be the same or a different
' worksheet and can be point within the worksheet providing the input and
' output ranges do not overlap. By setting this variables her, it becomes
' easy to change them if necessary. You could have successive days across the
' page or under the previous day's output just be changing these variables.
Set WshtDest = Worksheets("Source") ' Values for test 2
ColDestStart = 6
RowDestStart = 5
'Set WshtDest = Worksheets("Dest") ' Values for test 1
'ColDestStart = 1
'RowDestStart = 1
RowDestCrnt = RowDestStart
With Worksheets("Source")
' Assumes one header row
Set RngHdr = .Range(.Cells(1, 1), .Cells(1, NumCols))
RowSrcGrpStart = 2
PrefixCrnt = Mid(.Cells(RowSrcGrpStart, 1).Value, 1, 9)
RowSrcCrnt = RowSrcGrpStart + 1
Do While True
If PrefixCrnt <> Mid(.Cells(RowSrcCrnt, 1).Value, 1, 9) Then
' Current group finished
' Debug.Print "Group " & PrefixCrnt & " from row " & RowSrcGrpStart & " to " & RowSrcCrnt - 1
Set RngSrc = .Range(.Cells(RowSrcGrpStart, 1), _
.Cells(RowSrcCrnt - 1, NumCols))
' Copy header for group
RngHdr.Copy WshtDest.Cells(RowDestCrnt, ColDestStart)
RowDestCrnt = RowDestCrnt + 1
' Needed for totals row
RowDestGrpStart = RowDestCrnt
' Copy group
RngSrc.Copy WshtDest.Cells(RowDestCrnt, ColDestStart)
RowDestCrnt = RowDestCrnt + RowSrcCrnt - RowSrcGrpStart
' Build totals row
WshtDest.Cells(RowDestCrnt, ColDestStart).Value = "Geomean"
For ColDestCrnt = ColDestStart + 1 To ColDestStart + NumCols - 1
WshtDest.Cells(RowDestCrnt, ColDestCrnt).Value = _
"=Geomean(" & ColNumToCode(ColDestCrnt) & RowDestGrpStart & ":" & _
ColNumToCode(ColDestCrnt) & RowDestCrnt - 1 & ")"
Next
RowDestCrnt = RowDestCrnt + 2
If .Cells(RowSrcCrnt, 1).Value = "" Then
Exit Do
End If
RowSrcGrpStart = RowSrcCrnt
PrefixCrnt = Mid(.Cells(RowSrcGrpStart, 1).Value, 1, 9)
RowSrcCrnt = RowSrcGrpStart + 1
Else
' Current group not finished
RowSrcCrnt = RowSrcCrnt + 1
End If
Loop
End With
End Sub
Function ColNumToCode(ByVal ColNum As Long) As String
Dim Code As String
Dim PartNum As Long
' Last updated 3 Feb 12. Adapted to handle three character codes.
If ColNum = 0 Then
ColNumToCode = "0"
Else
Code = ""
Do While ColNum > 0
PartNum = (ColNum - 1) Mod 26
Code = Chr(65 + PartNum) & Code
ColNum = (ColNum - PartNum - 1) \ 26
Loop
End If
ColNumToCode = Code
End Function