0

圧電計データを含むスプレッドシートがあります。私が使用しているものははるかに大きく、半年ごとに更新していますが、要点は次のとおりです。

PZ #    Water EL    TIP    Pool   Tail
PZ-1A    888        864    910    880
PZ-1A    888        864    911    880
PZ-1A    888        864    912    880
PZ-1B    889        839    910    880
PZ-1B    889        839    911    880
PZ-1B    889        839    912    880
PZ-2     890        860    910    880
PZ-2     890        860    911    880
PZ-2     890        860    912    880

たとえば、「PZ-1A」タブが次のようになるように、ピエゾメーターごとに新しい (または既存の) タブを作成する必要があります。

PZ #    Water EL    TIP    Pool   Tail
PZ-1A    888        864    910    880
PZ-1A    888        864    911    880
PZ-1A    888        864    912    880

タブ「PZ-1B」は次のようになります

PZ #    Water EL    TIP    Pool   Tail
PZ-1B    889        839    910    880
PZ-1B    889        839    911    880
PZ-1B    889        839    912    880

タブ「PZ-2」は次のようになります

PZ #    Water EL    TIP    Pool   Tail
PZ-2     890        860    910    880
PZ-2     890        860    911    880
PZ-2     890        860    912    880

等々。一致セルを使用していくつかのことを試しましたが、投稿する価値はありません。PZ-1A のコードを取得したら、残りのコードをコピーするだけです。コメントフォームで必要なものは次のとおりです...

Sub find()
    For Each cell In Range("A")
        'select all cells that match the text "PZ-1A"
            'copy these entire rows to a new sheet named 'PZ-1A'
        'select all cells that match the text "PZ-1B"
            'copy these entire rows to a new sheet named 'PZ-1B'
        'select all cells that match the text "PZ-2"
            'copy these entire rows to a new sheet named 'PZ-2'
    Next cell
End Sub

私自身もこれに取り組み続けますが、まだまだ先は長いです。学校で Matlab を学びましたが、それは少し前のことで、今は VBA の旅を始めたばかりです。

私が協力できる有用なアドバイス/コードを持っている人はいますか?

4

2 に答える 2

1 
Sub ProcessRows()

    Dim rng As Range, cell As Range
    Set rng = ActiveSheet.Range(ActiveSheet.Range("A2"), _
                     ActiveSheet.Cells(Rows.Count, 1).End(xlUp))

    For Each cell In rng.Cells
        cell.EntireRow.Copy CopyTo(cell)
    Next cell

End Sub

'Return a range object to which a row should be copied
'  Range returned is determined by the value in "rng"
Function CopyTo(rng As Range) As Range
    Dim s As Excel.Worksheet, sName As String

    sName = Trim(rng.Value) 'just in case...

    On Error Resume Next               'ignore any error
    Set s = ThisWorkbook.Sheets(sName) 'see if we can grab the sheet
    On Error GoTo 0                    'stop ignoring errors

    If s Is Nothing Then    'sheet didn't exist: create it
        Set s = ThisWorkbook.Sheets.Add( _
          after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        s.Name = sName      
        rng.Parent.Rows(1).Copy s.Range("a1") 'copy headers
    End If                  'needed a new sheet
    'return the first empty cell in column 1
    Set CopyTo = s.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End Function
于 2013-08-26T21:38:09.843 に答える
0 
' initialize variables
Dim CurrentValue As String
Dim ExistingValue As String
Dim ExistingLine As Integer

Dim CopyValue1 As String
Dim CopyValue2 As String
Dim CopyValue3 As String
Dim CopyValue4 As String
Dim CopyValue5 As String

' loop through rows
For i = 2 To 9 ' change 500 to number of rows

    ' set to first sheet and get data
    Sheets(1).Select
    CurrentValue = Cells(i, 1).Value
    CopyValue1 = Cells(i, 1).Value
    CopyValue2 = Cells(i, 2).Value
    CopyValue3 = Cells(i, 3).Value
    CopyValue4 = Cells(i, 4).Value
    CopyValue5 = Cells(i, 5).Value

    ' check if current value is same as existing
    If CurrentValue = ExistingValue Then

        ' add to line
        ExistingLine = ExistingLine + 1

        ' select sheet
        Sheets(Sheets.Count).Select

    Else

        ' reset line
        ExistingValue = CurrentValue
        ExistingLine = 2

        ' create new sheet
        Sheets.Add After:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = CurrentValue

        ' populate data
        Sheets(Sheets.Count).Select
        Cells(1, 1) = "PZ #"
        Cells(1, 2) = "Water EL"
        Cells(1, 3) = "TIP"
        Cells(1, 4) = "Pool"
        Cells(1, 5) = "Tail"

    End If

    ' populate data
    Cells(ExistingLine, 1) = CopyValue1
    Cells(ExistingLine, 2) = CopyValue2
    Cells(ExistingLine, 3) = CopyValue3
    Cells(ExistingLine, 4) = CopyValue4
    Cells(ExistingLine, 5) = CopyValue5

Next i
于 2013-08-26T21:42:55.710 に答える