我试图检测并将标题列值存储到另一个过程的变量中,但由于某种原因,代码停在某一行并且不会返回错误。这是代码:
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
就像我说的,没有错误返回。所以我被卡住了,我不知道该怎么做。也许变量不匹配?语法错误?
谢谢你们。