二维表插值python_求将三列插值成二维表的VBA代码

Option Explicit

Sub ReorganizeData()

Dim arrR(), arrC(), arr, arrO, TRs As Integer, TCs As Integer, i As Integer, j As Integer, Multiple As Integer

Multiple = InputBox("请输入你要设置的步长", "步长设置", 5)

If Len(Multiple) = 0 Then Exit Sub

i = 0

Do

i = i + 1

ReDim Preserve arrC(1 To i)

arrC(i) = Application.WorksheetFunction.MRound(Application.WorksheetFunction.Min(Range("A:A")), Multiple) + (i - 1) * Multiple

Loop Until arrC(i) = Application.WorksheetFunction.MRound(Application.WorksheetFunction.Max(Range("A:A")), Multiple)

i = 0

Do

i = i + 1

ReDim Preserve arrR(1 To i)

arrR(i) = Application.WorksheetFunction.MRound(Application.WorksheetFunction.Min(Range("B:B")), Multiple) + (i - 1) * Multiple

Loop Until arrR(i) = Application.WorksheetFunction.MRound(Application.WorksheetFunction.Max(Range("B:B")), Multiple)

arr = Range("A3:C" & Range("A65536").End(xlUp).Row)

ReDim arrO(1 To UBound(arrR), 1 To UBound(arrC))

For j = 1 To UBound(arr)

arrO(Application.WorksheetFunction.Match(Application.WorksheetFunction.MRound(arr(j, 2), Multiple), arrR, 0), Application.WorksheetFunction.Match(Application.WorksheetFunction.MRound(arr(j, 1), Multiple), arrC, 0)) = arr(j, 3)

Next j

Range("D2:D65536,E1:AZ65536").Clear

Range("D2").Offset(0, 1).Resize(1, UBound(arrC)) = arrC

Range("D2").Offset(1, 0).Resize(UBound(arrR), 1) = Application.Transpose(arrR)

Range("D2").Offset(1, 1).Resize(UBound(arrO), UBound(arrO, 2)) = arrO

End Sub