0

以下は私のデータ（列ベクトル）の例です：

名前

あ

B

ハ

あ

B

ハ

[空白セル]

B

ハ

名前

あ

B

ハ

私のドキュメントの [空白のセル] は、実際には空白のセルであり、数式データなどはありません。

最終的には、NAME で区切られたデータを転置するだけです。NAME セルは、次のものを持つ唯一のセルです。

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

私のコードは転置を壊し、すべての名前とすべての [空白のセル] に対して新しい行を作成しています。

私は取得しようとしています:

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 が空白を比較している場合です。空白と大文字の空白は等しいので、これは常に真です。最初の if を以下に置き換えます。

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