Excel VBA-以分层方式将数据组织到结构中
我有这个csv文件,我想组织成一个结构。我正在测量一些表面,每个表面下都有部分,每个部分下都有一些管路。我想写一个结构代码,这样每个表面都有所有的部分,并在其下运行提取。结构应该是这样的。表面。以下是数据的外观: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
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,这是我到目前为止的代码,用于将上面发布的数据解析为曲面、部分、运行的层次顺序。它不起作用,如果你引导我实现我的目标,我会很高兴。非常感谢。