我有一列包含我想要处理的最终输出数据,此列中的数据给出的结果属于值非常接近的组。一旦我按升序对它们进行排序,它们看起来如下例所示:
Values
1.1
1.0
1.3
3.3
3.1
3.5
8.7
8.8
8.8
值的差异取决于计算,但它们通常非常接近。有没有办法自动将此列拆分为如下所示的数组?
Value 1 Value 2 Value 3
1.1 3.3 8.7
1.0 3.1 8.8
1.3 3.5 8.8
每个“组”中的结果数量是不可预测的,但组之间的最小差异是可以预测的。
是否有一个功能可以提供帮助?
使用宏后按组分类的实际数据:
3.314496 4.707067 5.765178 6.659030 7.449414 8.155307 9.981672 10.527740
3.315203 4.709271 5.765736 6.660503 7.449503 8.157916 9.981750 10.528012
3.315863 4.710029 5.766142 6.660533 7.449609 8.157919 9.982425 10.529845
3.315932 4.710119 5.766472 6.660641 7.449958 8.159919 9.982623 10.531364
3.316198 4.710421 5.766765 6.660654 7.451202 8.160223 9.984346 10.531996
3.316321 4.712422 5.766781 6.661423 7.451525 8.808907 9.984503 10.532077
3.316874 5.767053 6.662583 7.452031 8.809137 9.985143 10.532135
3.317010 5.767273 6.663421 7.452424 8.809198 9.986184 10.532675
3.317121 5.767418 6.663555 7.452803 8.810217 9.986405 10.532898
3.317911 5.767530 7.452806 8.810217 9.986435 10.533993
3.318345 5.767669 7.453056 8.810876 9.986791 10.535355
3.319082 5.768146 7.453588 8.811238 9.986828 10.535844
5.768337 7.453770 8.811370 9.986854
5.768448 7.453845 8.811435 9.987180
5.768824 7.453880 8.811577 9.987482
5.768931 7.453912 8.812060 9.987610
5.768971 7.453966 8.812245 9.987809
5.769521 7.453979 8.812363 9.987816
5.769725 7.454064 8.812508 9.987951
5.769920 7.454538 8.812781 9.988456
5.770123 7.455970 8.813038 9.990445
5.770187 7.456215 8.813130 9.990558
5.771034 7.456421 8.813236 9.990600
5.771230 7.456464 8.813414 9.991091
8.814133
8.814462
8.814524
8.814553
8.815093
答案1
编辑
根据您的评论,这就是您正在寻找的,因为您可以设置阈值(创建新“组”的两个数字之间的差异)
Sub Button1_Click()
Dim threshold As Double
threshold = 0.4 ' UPDATE THIS AS YOU SEE FIT
Dim column As Integer
column = 66 ' assumes the next column is B. 65 = A, 66=B, 67= C etc
Dim aRow As Integer
aRow = 1 ' The starting row where the data is
Dim otherRow As Integer
otherRow = aRow
Dim previousCol As Integer
previousCol = 64
Do While (True)
If (column = 90) Then
previousCol = previousCol + 1
column = 65
End If
If (Range("A" & aRow).Value = "") Then
Exit Do
End If
If (aRow <> 1) Then
If Range("A" & aRow).Value - Range("A" & aRow - 1).Value >= threshold Then
otherRow = 1
column = column + 1
End If
End If
If (previousCol < 65) Then
Range(Chr(column) & otherRow).Value = Range("A" & aRow).Value
Else
Range(Chr(previousCol) & Chr(column) & otherRow).Value = Range("A" & aRow).Value
End If
aRow = aRow + 1
otherRow = otherRow + 1
Loop
End Sub
现在唯一的区别是,您可以在代码中设置阈值(见上文),但它不再从 A 列中删除原始值(见下面的屏幕截图)。我想您可以手动删除它。
以上内容也仅限于 ZZ 列,大约有 700 列
先前的历史答案:
这个宏可以做你想做的事
Sub Button1_Click()
Dim column As Integer
column = 66
Dim aRow As Integer
aRow = 1
Dim otherRow As Integer
otherRow = 1
Dim current As Integer
current = -99
Do While (True)
If (Range("A" & aRow).Value = "") Then
Exit Do
End If
If (current < 0) Then
current = Split(Range("A" & aRow), ".")(0)
End If
If (Split(Range("A" & aRow), ".")(0) <> current) Then
current = Split(Range("A" & aRow), ".")(0)
otherRow = 1
column = column + 1
End If
Range(Chr(column) & otherRow).Value = Range("A" & aRow).Value
Range("A" & aRow).Value = "" 'Clear A column
otherRow = otherRow + 1
aRow = aRow + 1
Loop
End Sub
前
后
因此,需要注意的是:
- 它假设 A 列包含所有内容,并且会有空单元格(空单元格表示列表的末尾)
- 它按小数点 (.) 拆分。如果没有小数,它将被视为 N.0
- A 列变为空列,但我认为事后删除该列并不困难...或者,按照代码,您可以注释掉
Range("A" & aRow).Value = "" 'Clear A column
保留 A 列的行 - 在您给出的示例中,每个数字组有 3 个条目(3 个以 1.N 开头,3 个以 3.N 开头,3 个以 8.N 开头)。这不需要以 3 个为一组
- 它假设你的列表已经排序