[编程交流] C++或VBA

Sub LoadIDX()
   Dim aSheet As Worksheet
   Dim lngLastRow As Long, lngLastCol As Long
   Dim i, j, k, l As Integer
   Dim st, en, st1, en1 As Boolean
   Dim spli() As String
   Dim MyDate
   MyDate = Date    ' MyDate contains the current system date.
   aIDXfile = ThisWorkbook.Application.GetOpenFileName("IDX File to Open(*.idx),*.idx")
   If aIDXfile = False Then
      Exit Sub
   End If
ActiveSheet.PageSetup.CenterHeader = "&D  &B&ITime:&I&B&T"
  ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count) ' xlWorksheet ' Add New Sheet
  Set aSheet = ThisWorkbook.ActiveSheet
     aSheet.Activate
   Cells(1, 1).Interior.ColorIndex = 3 ' Culoare Celula
'    Range(Cells(1, 1), Cells(Rows.Count, Columns.Count)).Value = ""
'    Range(Cells(1, 1), Cells(Rows.Count, Columns.Count)).Borders.LineStyle = xlNone
'    Range(Cells(1, 1), Cells(Rows.Count, Columns.Count)).Interior.ColorIndex = 0
   aSheet.Cells(3, 4) = "Data :"
   Cells(3, 4).Font.ColorIndex = 3
   aSheet.Cells(3, 5) = Format(Date, "yyyy.mm.dd/") + Format(Time, "hh.mm.ss") 'Date
   Cells(3, 5).Font.ColorIndex = 3 ' 3=Rosu , 1=Negru
   aSheet.Cells(2, 2) = "Fisierul :"
   Cells(2, 2).Font.ColorIndex = 4 ' 4=Verde , 1=Negru
   aSheet.Cells(2, 3) = aIDXfile
   aSheet.Cells(4, 1) = "ID"
   aSheet.Cells(4, 2) = "Nume"
   aSheet.Cells(4, 3) = "Est [ m ]"
   aSheet.Cells(4, 4) = "Nord [ m ]"
   aSheet.Cells(4, 5) = "Cota [ m ]"
   aSheet.Cells(4, 6) = "Cod"
   l = 1
   While l < 9
   aSheet.Cells(4, l + 6) = "Atribut " + Format(l)
   l = l + 1
   Wend    ' End While loop when Count
   ActiveWindow.SplitRow = 3.5 ' Impartire Pagina
   Open aIDXfile For Input As #1    ' Open file for input.
i = 5
st = False
en = False
Do While Not EOF(1)    ' Loop until end of file.
   Line Input #1, mystring
   mystring = LTrim(mystring)
  If Left(mystring,  = "THEMINFO" Then
        en = True
  End If
   If st And en = False Then
        spli = Split(mystring, ",")
        Cod = spli(2)
'         For j = 1 To UBound(spli) '+ 1
'           vastr = Replace(spli(j - 1), Chr(34), "")
'           vastr = Replace(vastr, ";", "")
'           aSheet.Cells(i, j).Value = vastr
          aSheet.Cells(i, 1).Value = spli(0) ' Nr
          aSheet.Cells(i, 2).Value = spli(1) ' Nm
          aSheet.Cells(i, 3).Value = spli(3) ' E
          aSheet.Cells(i, 4).Value = spli(4) ' N
          aSheet.Cells(i, 5).Value = spli(5) ' Z
         If Cod <> "" Then
          aSheet.Cells(i, 6).Value = Cod
         End If ' Cod
'         Next j
        i = i + 1
   End If
  If Left(mystring, 6) = "POINTS" Then
        st = True
  End If
Loop
Close #1
lngLastRow = aSheet.Cells(Rows.Count, 2).End(xlUp).Row
lngLastCol = aSheet.Cells(4, 2).End(xlToRight).Column
Set RangeMax = Range(Cells(4, 1), Cells(lngLastRow, lngLastCol))
RangeMax.Borders.LineStyle = xlContinuous
Range(Cells(4, 1), Cells(4, lngLastCol)).Interior.Color = RGB(200, 200, 255)
Range(Cells(5, 1), Cells(lngLastRow, 1)).Interior.Color = RGB(240, 240, 240)
'Range(Cells(5, 3), Cells(lngLastRow, 5)) = Format(Format, "###0.00")
Range(Cells(3, 1), Cells(lngLastRow, lngLastCol)).Columns.AutoFit
Range("B5").Select
End Sub
'    "Point ID" "Point Name" "Esting" "Northing" "Elevation" "Code"