1

私は以下を達成する必要があります：

前

になる

後

基本的に、数値ヘッダーの間にスペースを挿入します (1.0、1.1、1.2、まだ存在しない場合はスペースを挿入します...)

また、番号が存在しない場合は、追加します (「前」の図のように、2.0 と 6.0 が欠落しています)。

次のように、データをチェックするための配列を作成する方法を見つけました。

Dim myRange As Range, c As Range
Dim x As Integer, i As Integer, arSize As Integer, y As Integer
Dim myArray() As String
x = 1
arSize = Int(Range("B" & Rows.Count).End(xlUp).Row)
ReDim myArray(1 To arSize)
Set myRange = Range("B1", Cells(Rows.Count, "B").End(xlUp))
For Each c In myRange
    If IsEmpty(c) = True Then
    myArray(x) = 0
    Else
        If IsNumeric(Left(c, 1)) = True Then
            myArray(x) = Val(Left(c, 1))
        Else: myArray(x) = -1
        End If
    End If
x = x + 1
Next
'for debugging:
For i = 1 To UBound(myArray)
    Range("F" & i).Value = myArray(i)
    Next i
End Sub

(最初の文字が数字の場合、その数字を配列要素に追加します。数字でない場合は要素を -1 に設定し、空白の場合は要素を 0 に設定します)

アドバイスや、目標を達成するためにデータを操作する方法の例が必要です。どうもありがとうございました。どんな助けでも感謝します。

4

3 に答える 3

2

この特定の問題に対して選択したアプローチは私にとって理想的なものではないようですが、あなたのアイデアはデータ管理/反復の面で多かれ少なかれ明確に見えます. 配列よりも Excel セルに依存したいと思います (より多くの情報を保存でき、コピーが容易で、関連付けることができる目的の形式と同等の構造を備えています)。必要なすべての変更を説明するのは簡単ではないので、必要なアクションを実行するアルゴリズムを書き留めることを好みました (皮肉なことに、少し前にこの手順を批判した後:))。このコードは、プロセス全体が完了した後にクリアされるすべての変更を格納するために、「一時的な列」 (デフォルトでは C) に依存していることに注意してください。お願いします、

Dim col2 As String: col2 = "C"
Dim firstRow As Integer: firstRow = 2
Set myRange = Range("B" & firstRow, Cells(Rows.Count, "B").End(xlUp))
Dim prevIndex As Integer: prevIndex = 1
Dim curRow As Long: curRow = firstRow - 1
For Each c In myRange
    curRow = curRow + 1
    Dim consecutive As Integer: consecutive = 0
    If Not IsEmpty(c) Then
        Dim written As Boolean: written = False
        Dim numRightBefore As Boolean: numRightBefore = False
        If IsNumeric(Left(c, 1)) = True Then
            Dim curIndex As Integer: curIndex = CInt(Left(c, 1))
            If (curIndex <> prevIndex) Then
               If (curIndex < prevIndex) Then
                   'Something went wrong
                   Exit For
               Else
                  If (curIndex = prevIndex + 1) Then
                      'Normal situation -> consecutive index
                      prevIndex = curIndex
                      If (consecutive <> 0) Then
                          Range(col2 & curRow).Value = ""
                          curRow = curRow + 1
                      End If
                  Else
                     Do While (curIndex > prevIndex + 1)
                        If (consecutive = 0) Then
                            Range(col2 & curRow).Value = ""
                            consecutive = 1
                         Else
                            curRow = curRow + 1
                         End If
                         prevIndex = prevIndex + 1
                         Range(col2 & curRow).Value = CStr(prevIndex) & ".0 text"
                         curRow = curRow + 1
                     Loop
                      prevIndex = prevIndex + 1
                      Range(col2 & curRow).Value = ""
                      curRow = curRow + 1
                  End If
               End If
            End If
        End If

        If (Not written) Then
            Range(col2 & curRow).Value = c.Value
        End If
        consecutive = curIndex
    End If
Next


Range(col2 & firstRow & ":" & col2 & curRow).Copy
myRange.PasteSpecial
Range(col2 & firstRow & ":" & col2 & curRow).Clear

注:大きすぎる配列を作成することはお勧めできません。正確な制限は、コンピュータの能力 (メモリ) と現在の状態 (実行中のプログラム) によって異なります。また、過去に VBA と大きな配列でいくつかの問題が発生したことにも注意してください。一般に (どのプログラミング言語でも)、サイズが 5000 を超える 1D 配列を宣言することはめったにありません。

注 2: Excel セルの読み取り/書き込みは、パフォーマンスの観点からすると、かなり悪いアプローチです。一般的にこれに依存することはお勧めしません (デフォルトでも)。これらの特定の条件下では、これは良いアイデアだと思いました。入力データのサイズが不明であり、OP が簡単に関連付けることができるアプローチを示しています。私は個人的に配列に依存し、特定のサイズ以上では一時ファイルに依存します (Excel からの読み取り/書き込みよりもはるかに高速です)。

于 2013-09-06T14:33:27.723 に答える
0

参照用のマクロのバージョンを次に示します。ケースselectで名前付き定数を参照しています。

Sub varocarbas()
Dim col2 As String: col2 = "C"
Dim firstRow As Integer: firstRow = 2
Set myRange = Range("B" & firstRow, Cells(Rows.Count, "B").End(xlUp))
Dim prevIndex As Integer: prevIndex = 1
Dim curRow As Long: curRow = firstRow - 1
For Each c In myRange
    curRow = curRow + 1


  Dim consecutive As Integer: consecutive = 0
    If Not IsEmpty(c) Then
        Dim written As Boolean: written = False
        Dim numRightBefore As Boolean: numRightBefore = False
        If IsNumeric(Left(c, 1)) = True Then
            Dim curIndex As Integer: curIndex = CInt(Left(c, 1))
            If (curIndex <> prevIndex) Then
               If (curIndex < prevIndex) Then
                   'Something went wrong
                   Exit For
               Else
                  If (curIndex = prevIndex + 1) Then
                      'Normal situation -> consecutive index
                      prevIndex = curIndex
                      If (consecutive <> 0) Then
                          Range(col2 & curRow).Value = ""
                          curRow = curRow + 1
                      End If
                  Else
                     Do While (curIndex > prevIndex + 1)
                        If (consecutive = 0) Then
                            Range(col2 & curRow).Value = ""
                            consecutive = 1
                         Else
                            curRow = curRow + 1
                         End If
                         prevIndex = prevIndex + 1
                            Dim sHeading As String
                         Select Case prevIndex
                            Case 1
                                sHeading = cIN
                            Case 2
                                sHeading = cTL
                            Case 3
                                sHeading = cPP
                            Case 4
                                sHeading = cRF
                            Case 5
                                sHeading = cPL
                            Case 6
                                sHeading = cPM
                            Case 7
                                sHeading = cPR
                            Case 8
                                sHeading = cRS
                            Case 9
                                sHeading = cCP
                            End Select
                         Range(col2 & curRow).Value = CStr(prevIndex) & ".0 " & sHeading
                         curRow = curRow + 1
                     Loop
                      prevIndex = prevIndex + 1
                      Range(col2 & curRow).Value = ""
                      curRow = curRow + 1
                  End If
               End If
            End If
        End If

        If (Not written) Then
            Range(col2 & curRow).Value = c.Value
        End If
        consecutive = curIndex
    End If
Next


Range(col2 & firstRow & ":" & col2 & curRow).Copy
myRange.PasteSpecial
Range(col2 & firstRow & ":" & col2 & curRow).Clear
End Sub
于 2013-09-06T17:29:20.163 に答える