Excel VBA标头检测器

时间:2016-07-29 18:44:44

标签: excel vba excel-vba

我试图检测并将标题列值存储到另一个过程的变量中,但由于某种原因,代码停在某一行并且不会返回错误。这是代码:

Dim myfolder As String
Dim MyFile As String
Dim SaveFolder As String
Dim strFile As String
Dim strPath As String
Dim currow As Integer
Dim i As Long
Dim stopvar As Boolean
Dim skipvar As Integer
Dim curcode As String
Option Explicit
Sub Master()
On Error Resume Next

Call OpenFiles

End Sub
Private Sub OpenFiles()

    SaveFolder = ActiveWorkbook.Path & "\Data\"
    myfolder = ActiveWorkbook.Path & "\Data\Raw\"
    MyFile = Dir(myfolder & "*.csv")
    Do While MyFile <> ""
        Workbooks.OpenText Filename:=myfolder & MyFile, DataType:=xlDelimited, Semicolon:=True, Local:=True
        Standardisation
        MyFile = Dir()
    Loop
    MsgBox ("Complété!")

End Sub
Private Sub Standardisation()
Dim Seance_Col As Integer
Dim Cat_Col As Integer
Dim Tarif_Col As Integer
Dim htPrix_Col As Integer
Dim Code_Col As Integer
Dim Seance_ColCheck As Boolean
Dim Cat_ColCheck As Boolean
Dim Tarif_ColCheck As Boolean
Dim htPrix_ColCheck As Boolean
Dim Code_ColCheck As Boolean
Dim Allset As Boolean
Dim RowCol As String
Dim Seance_Num As String
Dim Cat_Num As String
Dim Tarif_Num As String
Dim htprix_Num As String
Dim Code_Num As String
Dim lastrow As Integer
Dim i As Integer
    '==========================================================================
    ' Procédures pour renommer correctement le fichier
    '==========================================================================
    strPath = Application.ActiveWorkbook.FullName
    strFile = MyFile
    strFile = Right(strPath, Len(strPath) - InStrRev(strPath, "\"))
    strFile = Left(strFile, Len(strFile) - (Len(strFile) - InStrRev(strFile, ".") + 1))
    strFile = Left(strFile, Len(strFile) - 9)
    strFile = strFile
    Workbooks(MyFile).SaveAs Filename:=SaveFolder & strFile, FileFormat:=51
    ActiveSheet.Name = "Sheet1"

    '==========================================================================
    'Converti le fichier .csv en format facile à travailler pour Excel
    '==========================================================================
    ActiveWorkbook.Sheets(1).Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=True, OtherChar:= _
        ";", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True

    '==========================================================================
    'Fixes the ASCII errors... because it's 2016 Goddammit
    '==========================================================================
    Worksheets(1).Cells.Select
    Selection.Replace _
    What:="é", Replacement:="e", _
    SearchOrder:=xlByColumns, MatchCase:=True
    Worksheets(1).Select
    Selection.Replace _
    What:="É", Replacement:="E", _
    SearchOrder:=xlByColumns, MatchCase:=True
    Worksheets(1).Select
    Selection.Replace _
    What:="Ô", Replacement:="O", _
    SearchOrder:=xlByColumns, MatchCase:=True
    Worksheets(1).Select
    Selection.Replace _
    What:="è", Replacement:="e", _
    SearchOrder:=xlByColumns, MatchCase:=True
    Worksheets(1).Select
    Selection.Replace _
    What:="BDM -", Replacement:="Regulier BDM -", _
    SearchOrder:=xlByColumns, MatchCase:=True


    '==========================================================================
    '                           Header Detector
    '==========================================================================
    Do While Allset = False

        If Seance_ColCheck = True And _
        Cat_ColCheck = True And _
        Tarif_ColCheck = True And _
        htPrix_ColCheck = True And _
        Code_ColCheck = True Then
            Allset = True
        End If
        RowCol = Workbooks(MyFile).Sheets(1).Range("A1").Address
        Select Case True
        Case (Workbooks(MyFile).Sheets(1).Range(RowCol).Value Like "S?ance")
            Seance_Col = Range(RowCol).Column
            Seance_ColCheck = True
        Case (Workbooks(MyFile).Sheets(1).Range(RowCol).Value Like "Cat?gorie")
            Cat_Col = Range(RowCol).Column
            Cat_ColCheck = True
        Case (Workbooks(MyFile).Sheets(1).Range(RowCol).Value Like "Tarif")
            Tarif_Col = Range(RowCol).Column
            Tarif_ColCheck = True
        Case (Workbooks(MyFile).Sheets(1).Range(RowCol).Value Like "ht Prix*")
            htPrix_Col = Range(RowCol).Column
            htPrix_ColCheck = True
        Case (Workbooks(MyFile).Sheets(1).Range(RowCol).Value Like "Code r*")
            Code_Col = Range(RowCol).Column
            Code_ColCheck = True
        RowCol = Workbooks(MyFile).Sheets(1).Range(RowCol).Offset(0, 1).Address
        End Select
    Loop
    '==========================================================================
    '                             Converter
    '==========================================================================
    Seance_Num = ConvertToLetter(Seance_Col)
    Cat_Num = ConvertToLetter(Cat_Col)
    Tarif_Num = ConvertToLetter(Tarif_Col)
    htprix_Num = ConvertToLetter(htPrix_Col)
    Code_Num = ConvertToLetter(Code_Col)
    '==========================================================================
    '                      Comps standarsation operator
    '==========================================================================
    lastrow = ActiveWorkbook.Sheets(1).Range("s" & Rows.Count).End(xlUp).Row
    For i = 2 To lastrow
    If Worksheets(1).Cells(i, Code_Num).Value <> "" Then
        Worksheets(1).Cells(i, Tarif_Num).Value = "Faveur"
    End If
    Next i

    'Ferme le fichier
    ActiveWorkbook.Save
    ActiveWorkbook.Close savechanges:=False

End Sub
Private Sub CloseAllBooks()
Dim wb As Workbook

For Each wb In Workbooks
     If Not (wb Is ActiveWorkbook) Then wb.Close
Next

End Sub

Sub A_SelectAllMakeTable()
    Dim tbl As ListObject
    Dim rng As Range

    Set rng = Range(Range("A1"), Range("A1").SpecialCells(xlLastCell))
    Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, rng, , xlYes)
    tbl.TableStyle = "TableStyleMedium15"
End Sub
Function ConvertToLetter(iCol As Integer) As String
   Dim iAlpha As Integer
   Dim iRemainder As Integer
   iAlpha = Int(iCol / 27)
   iRemainder = iCol - (iAlpha * 26)
   If iAlpha > 0 Then
      ConvertToLetter = Chr(iAlpha + 64)
   End If
   If iRemainder > 0 Then
      ConvertToLetter = ConvertToLetter & Chr(iRemainder + 64)
   End If
End Function

错误发生在&#34; Header Detector&#34;更具体地说,在这一行:

RowCol = Workbooks(MyFile).Sheets(1).Range("A1").Address

就像我说的,没有错误返回。所以我被卡住了,我不知道该怎么做。也许变量不匹配?语法错误?

谢谢你们。

0 个答案:

没有答案