0

下面是我的数据示例（列向量）：

姓名

一个

乙

C

一个

乙

C

[空白单元格]

乙

C

姓名

一个

乙

C

请注意，我文档中的 [空白单元格] 实际上只是一个空白单元格，没有公式数据等。

最终，我只需要转置由 NAME 分隔的数据。NAME 单元格是唯一具有以下内容的单元格：

Left(rngCell.Value, 2) = Left(StrConv(rngCell.Value, vbUpperCase), 2)

我的代码正在破坏我的转置并为所有 NAME 和所有 [空白单元格] 创建一个新行。

我试图得到：

NAME A B C A B C   B C

NAME A B C A B C A B C

NAME A B C   B C   B C

但我的代码正在返回：

NAME A B C A B C

B C

NAME A B C A B C A B C

NAME A B C

B C

B C

这是我正在使用的代码：

Sub Dataclean()

Dim lngRowLast As Long, _
lngRowPaste As Long, _
lngColOffset As Long
Dim rngCell As Range, _
rngDataSet As Range
Dim strSourceTab As String, _
strOutputTab As String

 'Tab name containing source data.  Change to suit.
strSourceTab = "sheet2pull"
 'Tab name for data output.  Change to suit.
strOutputTab = "transposed"

lngRowLast = Sheets(strSourceTab).Cells(Rows.Count, "A").End(xlUp).Row

 'Assumes the original dataset is in Column A and starts at Row 1.  Change to suit.
Set rngDataSet = Sheets(strSourceTab).Range("A1:A" & lngRowLast)

Application.ScreenUpdating = False

For Each rngCell In rngDataSet

    If Left(rngCell.Value, 2) = Left(StrConv(rngCell.Value, vbUpperCase), 2) Then
        If lngRowPaste = 0 And lngColOffset = 0 Then
            lngRowPaste = 1
            lngColOffset = 1
        Else
            lngRowPaste = lngRowPaste + 1
            lngColOffset = 1
        End If
    ElseIf lngRowPaste = 0 And lngColOffset = 0 Then
        lngRowPaste = 1
        lngColOffset = 1
    End If

    Sheets(strOutputTab).Cells(lngRowPaste, lngColOffset).Value = rngCell.Value
    lngColOffset = lngColOffset + 1

Next rngCell

Application.ScreenUpdating = True


End Sub

如果我不清楚或感到困惑，请告诉我。我试图尽可能明确，但通常很难解释！太感谢了。

我对VBA有点陌生，但正在学习。

4

1 回答 1

0

你的错误是当第一个 if 比较空白时。这将始终正确，因为空格和大写空格 a 是相等的。将您的第一个 if 替换为以下内容。

If Left(rngCell.Value, 2) = Left(StrConv(rngCell.Value, vbUpperCase), 2) And _
    Not IsBlank(rngCell.Value) Then
于 2013-04-02T19:31:34.587 回答