VBA:向列中添加字符并调整范围大小



我正在编写一个宏,希望能将单元格A1、A2、A3、A4、A5、A6…中的值分别复制到列C1、D1、E1、C2、D2、E2…中。我还想在每个复制的单元格前后添加字符。这是我目前阅读后得到的如何将文本添加到Excel中所有单元格的开头或结尾?以及其他一些网站。

Sub reformat()
Dim c As Range
dim destination As Range
Set destination=Range("C1")
Set destination=destination.Resize(3,33)
For Each c In Selection
If c.Value<>" " Then destination.Value="beginning"&c.Value&"ending"
Next
End Sub

这为线路If c.Value<>" " Then提供了以下错误消息run-time error'91':object variable or with block variable not set。我最大的问题是弄清楚如何将值复制到具有更多列的指定区域。


更新:感谢Stefan的建议,我已将代码更改为以下代码:

Sub reformat()
Dim c As Range
dim destination As Range
Set destination=Range("C1")
destination=destination.Resize(3,33)
For Each c In Selection
If c.Value<>" " Then destination.Value="beginning"&c.Value&"ending"
Next
End Sub

现在,旧的问题不再出现,而是只填充了单元格C1。

此代码将所选值复制到[M1]中左上角的3列矩阵中:

Sub reformat()
' copy cell values from selection into 3-column wide destination
' http://stackoverflow.com/questions/34473802/vba-add-char-to-a-column-and-resize-the-range#34473802
' 2015-12-26
    Dim c As Range, destination As Range
    Dim ct As Long
    ct = Selection.Cells.Count
    Set destination = Range("M1").Resize(CInt((ct + 1) / 3), 3)
    ct = 0
    For Each c In Selection
        If c.Value <> "" Then
            destination(CInt(ct  3) + 1, (ct Mod 3) + 1).Value = "beginning" & c.Value & "ending"
            ct = ct + 1
        End If
    Next
End Sub

在中

Set destination=Range("C1") 
Set destination=destination.Resize(3,33)

您应该只使用set一次来初始化destination对象。

我想你应该说

destination.resize(3,33)

编辑

Dim c As Range
dim destination As Range
Set destination=Range("C1")
destination.Resize(3,33)
I=0
For Each c In Selection
   If c.Value<>"" Then    
      destination.offset(i).Value="beginning"&c.Value&"ending"
   Endif
   I=i+1
Next
End Sub
    Dim c As Range
    Dim destination As Range
    Set destination = Range("C1")
    i = 0
    For Each c In Selection
       If c.Value <> " " Then
          destination.Offset(i  3, i Mod 3).Value = "beginning" & c.Value & "ending"
       End If
       i = i + 1
Next

最新更新