find要复制到的单元头

我有以下问题：我试图自动将数据复制到标题指定的某个列，但它出错：“对象variables或未设置块”。 我想要做的是将行标题添加到一个一维数组，find与search到的mth_exp_PM相匹配的范围，并将其存储在另一个variables，最好是设置范围（单元格？）以进一步复制。

我究竟做错了什么 ？ 如果这个解决scheme不好，根据行标题复制到列的最好/更简单的解决scheme是什么？

谢谢！

dim i as long dim cell, cell_adr as range dim arr() as string dim mth_exp_PM as string 'this value is taken from a different workbook and it matches one row header value i = 0 For Each cell In Range(Range("D1"), Range("D1").End(xlToRight).Offset(0, -1)).Cells ReDim Preserve arr(i) arr(i) = cell If arr(i) = mth_exp_PM Then cell_adr = arr(i) Debug.Print cell_adr End If i = i + 1 Next cell 

Answer 1

在IF条件下而不是

 cell_adr = arr(i) 

使用

 Set cell_adr = cell 

cell是一个范围，将被分配给cell_adr ，这又是一个范围。 要获取单元格的地址， Debug.Print cell_adr.Address为Debug.Print cell_adr使用Debug.Print cell_adr 。

如果你在你的代码的其他地方不使用arr ，你可以删除它。 在下面的代码中，我已经评论过不需要的行，如果你不需要使用数组。

 Sub Demo() 'Dim i As Long Dim cell As Range, cell_adr As Range 'declare cell as Range 'Dim arr() As String Dim mth_exp_PM As String 'this value is taken from a different workbook and it matches one row header value 'i = 0 For Each cell In Range(Range("D1"), Range("D1").End(xlToRight).Offset(0, -1)).Cells 'ReDim Preserve arr(i) 'arr(i) = cell 'If arr(i) = mth_exp_PM Then If cell = mth_exp_PM Then Set cell_adr = cell Debug.Print cell_adr.Address End If 'i = i + 1 Next cell End Sub 

Answer 2

一行校正需要，主要是（ arr(i) = cell.value ）

波纹pipe提出了你的代码修正的修正。

 dim i as long dim cell, cell_adr as range dim arr() as string dim mth_exp_PM as string 'this value is taken from a different workbook and it matches one row header value i = 0 For Each cell In Range(Range("D1"), Range("D1").End(xlToRight).Offset(0, -1)).Cells ReDim Preserve arr(i) arr(i) = cell.value 'Do correct here! If arr(i) = mth_exp_PM Then Set cell_adr = cell 'Correct here! Debug.Print cell_adr.Address 'and Correct here End If i = i + 1 Next cell