Excel VBA中基于带星号标识符的固定X点和Y点的X点和Y点对齐
您好，我正在使用VBA Excel处理一个小项目，我有一个任务，任务分解如下：Excel VBA中基于带星号标识符的固定X点和Y点的X点和Y点对齐,excel,vba,Excel,Vba,您好，我正在使用VBA Excel处理一个小项目，我有一个任务，任务分解如下： 将列A、B和C转换为三个单独的数组-已实现 运行D列的条件检查以标识“*PP-”——尽管这运行得不太好，主要是基于检查D列的if语句和循环 建立了一个计数器来计数没有“*PP-”的单元格 试图从另一个单元格中减去满足条件“*PP-”的单元格值，但无法使用数组或范围 尝试获取差值并除以计数以获得增量，然后将这些增量添加到与第一个“*PP-”相对应的第一个值中 然后在表格上打印所需范围内的所有内容 我的代码如下： Sub
Sub Point_Align()
Dim LastRow As Long
Dim Rng As Range, Cell As Range
Dim rng2 As Range, Cell1 As Variant
Dim rng3 As Range, Cell2 As Variant
Dim rng4 As Range, Cell3 As Range
Dim rng5 As Range, Cell4 As Range
Dim rng6 As Range
Dim rng7 As Range
Dim Val As String, val1 As Object, val2 As Long
Dim Posn As Long
Dim x As Variant
Dim x1 As Variant
Dim x2 As Variant
Dim xarray() As Variant
Dim xarray2() As Variant
Dim y As Range
Dim y1 As Range
Dim y2 As Range
Dim yarray() As Variant
Dim yarray2() As Variant
Dim z As Range
Dim z1 As Range
Dim zarray() As Variant
Dim darray() As Variant
'Finding the last row with data in column A
LastRow = Cells(Rows.count, "D").End(xlUp).Row
'Setting the range in column A
Set Rng = Range("D1:D" & LastRow)
xarray() = Range("A1:A" & LastRow)
yarray() = Range("B1:B" & LastRow)
zarray() = Range("C1:C" & LastRow)
Dim count As Long
Set rng2 = ActiveSheet.Range("E1:E" & LastRow)
Set rng3 = ActiveSheet.Range("F1:F" & LastRow)
Set rng4 = ActiveSheet.Range("G1:G" & LastRow)
Set rng5 = ActiveSheet.Range("H1:H" & LastRow)
For Each Cell In Rng
Val = Cell.Value
Posn = InStr(Val, "*PP-")
Next Cell
For Each Cell1 In xarray()
val1 = Cell1.Value
Debug.Print (val1)
Next Cell1
For Each Cell2 In yarray()
val2 = Cell2.Value
Next Cell2
If Posn = 1 Then
For count = 1 To Posn = 0
count = count + 1
rng2.Value = WorksheetFunction.Transpose(xarray())
rng3.Value = WorksheetFunction.Transpose(yarray())
rng4.Value = WorksheetFunction.Transpose(zarray())
rng5.Value = WorksheetFunction.Transpose(Rng)
Cell3.Value = rng2.Value
Cell4.Value = rng3.Value
Next count
End If
If Posn = 0 Then
count = 1
Cell1.Value = rng2.Value
Cell2.Value = rng3.Value
x = Cell1.Value
y = Cell2.Value
x1 = x / count
y1 = y / count
x2 = x1 + x.Value
x2 = xarray2()
y2 = x1 + y.Value
y2 = yarray2()
rng5.Value = WorksheetFunction.Transpose(xarray2())
rng6.Value = WorksheetFunction.Transpose(yarray2())
rng7.Value = WorksheetFunction.Transpose(z)
Cell.Value = WorksheetFuncation.Transpose(Range("H1:H" & LastRow))
End If