Excel VBA-以分层方式将数据组织到结构中

Excel VBA-以分层方式将数据组织到结构中,excel,vba,Excel,Vba,我有这个csv文件,我想组织成一个结构。我正在测量一些表面,每个表面下都有部分,每个部分下都有一些管路。我想写一个结构代码,这样每个表面都有所有的部分,并在其下运行提取。结构应该是这样的。表面。以下是数据的外观: SURFACE SECTION RUN -0.07764007 0.07762 42 0.07801 -0.07747896 0.07744 -0.07753022 0.07759 -0.07729586 0.07747 -0.07753753 0.07741 -0.07742768

我有这个csv文件,我想组织成一个结构。我正在测量一些表面,每个表面下都有部分,每个部分下都有一些管路。我想写一个结构代码,这样每个表面都有所有的部分,并在其下运行提取。结构应该是这样的。表面。以下是数据的外观:

SURFACE
SECTION
RUN
-0.07764007
0.07762
42
0.07801
-0.07747896
0.07744
-0.07753022
0.07759
-0.07729586
0.07747
-0.07753753
0.07741
-0.07742768
RUN
-0.077435
0.07747
-0.07757416
0.07726
-0.07761077
0.07756
-0.07750092
-57
-0.07712009
0.07771
-0.07769133
0.07769
-0.07713472
0.07733
-0.07726657
0.0774
-0.07731783
0.07743
-0.07754486
0.07752
-0.07755219
0.07745
-0.07723726
SECTION
RUN
-0.07785247
0.07765
-0.07742036
-0.0776
-0.07742036
0.07747
-0.07729586
0.07741
-0.07744966
0.07724
-0.07753753
0.0773
-0.07747896
0.07759
-0.07746429
0.07771
SURFACE
SECTION
RUN
-0.07753753
0.07786
-0.07729586
0.07743
-0.07762542
0.07763
-0.07723726
0.07735
-0.077955
-71
-0.07681249
0.07727
-0.0775229
0.07733
-0.07747896
0.07738
-0.07714205
0.07746
-0.07737642
0.07744
-0.07761809
0.07727
-0.07755951
0.07754
-0.07792571

Option Explicit
Public Type RUN_Type
RUN_STRUCT() As Variant
End Type

Public Type SECTION_Type
SECTION_STRUCT() As RUN_Type
End Type

Sub actual2()



Dim surface As String, Section As String, run As String
Dim DATA() As Variant, counter_surf  As Long, counter_sect As Long
Dim counter_run As Long
Dim SURFACE_STRUCT() As SECTION_Type, n As Long, m As Long
Dim counter As Integer
Dim Endoffileflag As Boolean, errorflag As Boolean



surface = "SURFACE"
Section = "SECTION"
run = "RUN"
counter = 0
counter_surf = 0
counter_sect = 0
counter_run = 0
Endoffileflag = False
errorflag = False



 Do While counter <= UBound(DATA) And Endoffileflag = False
 If Endoffileflag = False Then
 errorflag = True
 End If
 Do While DATA(counter) = surface And Endofflileflag = False

    ReDim Preserve SURFACE_STRUCT(counter_surf)
    If counter < UBound(DATA) Then
    errorflag = True
    End If

        Do While DATA(counter) = Section And Endofflileflag = False
            ReDim Preserve SECTION_STRUCT(counter_sect)
            If counter < UBound(DATA) Then
            errorflag = True
            End If

            Do While DATA(counter) = run And Endofflileflag = False
            ReDim Preserve RUN_STRUCT(counter_run)
            If counter < UBound(DATA) And IsNumeric(DATA(counter)) Then
            errorflag = True
            SURFACE_STRUCT(counter_surf).SECTION_STRUCT(counter_sect).,
            RUN_STRUCT(counter_run) = (DATA(counter))
            End If
            counter_run = counter_run + 1

        Loop
            counter_sect = counter_sect + 1
        Loop
    counter_surf = counter_surf + 1
 Loop

counter = counter + 1
Loop

Close #2
End Sub
Thank you.

嘿,我不知道你是否还需要它,但是,你可以用一个类型轻松地完成这项工作,因为你的对象除了存储数据之外,实际上什么都不做

这只是它如何工作的一个例子:

Option Explicit
Option Base 1

Public Type RUN_Type
  Values() As Double
End Type

Public Type SECTION_Type
  Runs() As RUN_Type
End Type

Public Type SURFACE_Type
 Sections() As SECTION_Type
End Type

Sub actual2()
  Const surface = "SURFACE"
  Const section = "SECTION"
  Const run = "RUN"

  Dim DATA() As Variant, surfaces() As SURFACE_Type
  Dim counter As Long, counter_surf  As Long, counter_sect As Long, counter_run As Long, counter_num As Long

  counter = 1
  DATA = Range(Cells(1, 1), Cells(86, 1)).Value

  Do While DATA(counter, 1) = surface
        incr counter_surf
        ReDim Preserve surfaces(counter_surf)
        incr counter
        If counter > UBound(DATA) Then
              endRead surfaces
              Exit Sub
        End If
        Do While DATA(counter, 1) = section
              incr counter_sect
              ReDim Preserve surfaces(counter_surf).Sections(counter_sect)
              incr counter
              If counter > UBound(DATA) Then
                    endRead surfaces
                    Exit Sub
              End If
              Do While DATA(counter, 1) = run
                    incr counter_run
                    ReDim Preserve surfaces(counter_surf).Sections(counter_sect).Runs(counter_run)
                    incr counter
                    If counter > UBound(DATA) Then
                                endRead surfaces
                          Exit Sub
                    End If
                    Do While IsNumeric(DATA(counter, 1))
                          incr counter_num
                          ReDim Preserve surfaces(counter_surf).Sections(counter_sect).Runs(counter_run).Values(counter_num)
                          surfaces(counter_surf).Sections(counter_sect).Runs(counter_run).Values(counter_num) = DATA(counter, 1)
                          incr counter
                          If counter > UBound(DATA) Then
                                endRead surfaces
                                Exit Sub
                          End If
                    Loop
                    counter_num = 0
              Loop
              counter_run = 0
        Loop
        counter_sect = 0
  Loop
End Sub

Public Sub endRead(surfaces() As SURFACE_Type)

  Const surface = "SURFACE"
  Const section = "SECTION"
  Const run = "RUN"

  Dim ws As Worksheet
  Dim counter As Long, i As Long, j As Long, k As Long, l As Long

  Set ws = ThisWorkbook.Worksheets("Sheet1")
  counter = 1

  For i = LBound(surfaces) To UBound(surfaces)
        ws.Cells(counter, 2).Value = surface
        incr counter
        For j = LBound(surfaces(i).Sections) To UBound(surfaces(i).Sections)
              ws.Cells(counter, 3).Value = section
              incr counter
              For k = LBound(surfaces(i).Sections(j).Runs) To UBound(surfaces(i).Sections(j).Runs)
                    ws.Cells(counter, 4).Value = run
                    incr counter
                    For l = LBound(surfaces(i).Sections(j).Runs(k).Values) To UBound(surfaces(i).Sections(j).Runs(k).Values)
                          ws.Cells(counter, 5).Value = surfaces(i).Sections(j).Runs(k).Values(l)
                          incr counter
                    Next l
              Next k
        Next j
  Next i

End Sub

 Public Function incr(lng As Long)
    lng = lng + 1
End Function

StackOverflow不鼓励在没有尝试或起点的情况下编写完整的代码。查看类模块。您可以创建一个名为surface的类和一个名为section的类。然后,曲面包含部分,它们可以依次包含“运行”属性。请,MacroMarc,这是我到目前为止的代码,用于将上面发布的数据解析为曲面、部分、运行的层次顺序。它不起作用,如果你引导我实现我的目标,我会很高兴。非常感谢。