时间戳

首页 > 解决方案 > 范围输入

excel - 范围输入

问题描述

不太确定我的代码有什么问题，但它没有在一个直列中打印。当你说它有效

cells(i,j).copy
range(i,j).pastespecial

但是当您请求一系列值时，会抛出完全随机的单元格中的值，例如

set rng=Application.inputbox(" Please select range", Type=:8)

除非您要求用户选择范围，否则一切正常。

Sub select1()

Dim rng As Variant
Dim i, j, k As Integer

Set rng = Application.InputBox("please select range", Type:=8)

With ActiveSheet
  i = 1
  k = 1
  For j = 1 To rng.Columns.Count
     For i = 1 To rng.Rows.Count
       rng(Cells(i, j)).Copy
       Range("l" & k).PasteSpecial
       k = k + 1
     Next i
     i = 1
 Next j
End With

End Sub

所以对于这张表

jenny   doon    felix   spi gav benj    amanda
jenny   doon    felix   spi gav benj    amanda
jenny   doon    felix   spi gav benj    amanda
jenny   doon    felix   spi gav benj    amanda
jenny   doon    felix   spi gav benj    amanda
jenny   doon    felix   spi gav benj    amanda

我必须得到（在 1 列中）

jenny
jenny
jenny
jenny
jenny
doon
doon
doon
doon
doon
felix
felix
felix
felix
felix
spi
spi
spi
spi
spi
gav
gav
gav
gav
gav
benj
benj
benj
benj
benj

标签： excelvbainputrange

解决方案

这个

rng(Cells(i, j)).Copy
Range("L" & k).PasteSpecial

应该

rng.Cells(i, j).Copy
.Range("L" & k).PasteSpecial

或者

rng.Cells(i, j).Copy Destination:=.Range("L" & k)

或者，如果您只想复制该值，那么这会更好：

.Range("L" & k).Value = rng.Cells(i, j).Value

总的来说，我推荐以下

  • 为您引入一些错误处理，Application.InputBox否则如果用户按下Cancel按钮，它将失败。

  • 测试是否选择了多个区域（我们不知道如何处理它们，所以我们需要禁止它们）。

  • 使用数组：将源范围读入数组SrcArr = SrcRng.Value并使用数组进行输出ReDim DestArr(1 To SrcRng.Cells.Count, 1 To 1) As Variant。这样，您只有一个单元格读/写操作，这使您的代码更快。转换完全在数组内执行。

所以你最终得到......</p> 

Option Explicit

Public Sub TransformRange()
    Dim SrcRng As Range
    On Error Resume Next 'next line throws error if user presses cancel so hide all errors
    Set SrcRng = Application.InputBox("please select range", Type:=8)
    On Error GoTo 0 'don't forget to re-activate error reporting

    If SrcRng Is Nothing Then Exit Sub

    If SrcRng.Areas.Count > 1 Then
        MsgBox "More than one area was selected I'm not sure what to do"
        Exit Sub
    End If

    'read everything into an array
    Dim SrcArr() As Variant
    SrcArr = SrcRng.Value

    'transform values
    ReDim DestArr(1 To SrcRng.Cells.Count, 1 To 1) As Variant
    Dim iRow As Long, iCol As Long, iArr As Long
    iArr = 1 'initialize

    For iCol = 1 To UBound(SrcArr, 2)
        For iRow = 1 To UBound(SrcArr, 1)
            DestArr(iArr, 1) = SrcArr(iRow, iCol)
            iArr = iArr + 1
        Next iRow
    Next iCol

    'write values into sheet
    SrcRng.Parent.Range("L1").Resize(RowSize:=UBound(DestArr, 1)).Value = DestArr
    'SrcRng.Parent <-- this represents the sheet of the selected range
End Sub

推荐阅读