如題，

思路

循環D列數據

循環K列數據

将abs(D-K)的值存入一個數組

Next K

設計一個單獨的函數，完成如下功能：返回最小絕對值對應的數值所在的行數

根據函數返回的行和已知的列，定位具體單元格，并将其存儲在一個數組中

Next D

一次性将該數組寫入到單元格

代碼

Sub t() ' 主過程 Dim x!, y!, r1!, r2! Dim arr1, arr2, temp_arr, conp_return, result_arr, result$ ' arr1 數組，一次性寫入D列 ' arr2 數組，一次性寫入K列數據 ' temp_arr 數組，存儲D列 - K列每一個數的絕對值 ' conp_return 數組，接收conparison函數返回的數組 ' result_arr 數組，依次存儲D列每一個數對應的結果 ' result 字符串，臨時存儲G列對應的值 r1 = [d2].End(xlDown).Row r2 = [k2].End(xlDown).Row arr1 = Range("d2:d" & r1) arr2 = Range("k2:k" & r2) ReDim result_arr(1 To r1) For x = 2 To r1 ReDim temp_arr(1 To r2) For y = 2 To r2 temp_arr(y - 1) = Abs(arr1(x - 1, 1) - arr2(y - 1, 1)) Next y conp_return = conparison(temp_arr) result = "" For y = 1 To UBound(conp_return) - 1 result = Cells(conp_return(y), "g") & "," & result Next y result_arr(x - 1) = VBA.Left(result, Len(result) - 1) Erase temp_arr Next x [e2].Resize(r1) = Application.Transpose(result_arr) End Sub Function conparison(arr) ' 返回最小絕對值對應的數所在行，考慮最小絕對值有可能不止一個，所以最好返回一個數組 Dim min_value As Double, i!, result_arr, element ReDim result_arr(1 To 1) min_value = Application.Min(arr) i = 1 For element = 1 To UBound(arr) If arr(element) = min_value Then result_arr(i) = element 1 ' 最小絕對值對應的數所在行 = 數組中的位置 1 ​ i = i 1 ReDim Preserve result_arr(1 To i) End If Next element conparison = result_arr ​ End Function

效果

更多精彩资讯请关注tft每日頭條，我们将持续为您更新最新资讯!