Sitede bulmuş olduğum asadaki kotlarla html uzantılı dosyaları okumaktayım. Fakat şimdi bir sorunum var yardımcı olursanız sevinirim. Sorunum html dosyasında 1/1 1/2 1/4 ve bu (/) şeklide olduğu zaman 42736 şekline çevirip getiriyor. Benim istediğim html değiştirmeden (1/1) aynısı okuması yardımlarınız için teşekkürler.
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B:A")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
Application.EnableEvents = False
Set s2 = Sheets("Sayfa2")
s2.Cells.ClearContents
With s2.QueryTables.Add(Connection:= _
"URL;file:///" & ThisWorkbook.Path & "/" & Target.Text & ".html", Destination:=s2.Range("$A$1" _
))
.Name = ""
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "1,4,3"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Cells(Target.Row, "B") = s2.Range("C4")
Cells(Target.Row, "C") = s2.Range("C5")
Cells(Target.Row, "D") = s2.Range("C6")
Cells(Target.Row, "E") = s2.Range("C7")
Cells(Target.Row, "F") = s2.Range("F2")
Cells(Target.Row, "u") = s2.Range("c8")
'Cells(Target.Row, "W") = s2.Range("c8")
Cells(Target.Row, "G") = s2.Range("F3")
Cells(Target.Row, "H") = s2.Range("F4")
Cells(Target.Row, "I") = s2.Range("C2")
Cells(Target.Row, "J") = s2.Range("A12")
Cells(Target.Row, "K") = s2.Range("B12")
Cells(Target.Row, "N") = s2.Range("e12")
Cells(Target.Row, "O") = s2.Range("f12")
Cells(Target.Row, "P") = s2.Range("g12")
Cells(Target.Row, "Q") = s2.Range("H12")
Cells(Target.Row, "R") = s2.Range("a21")
Cells(Target.Row, "S") = s2.Range("D21")
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B:A")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
Application.EnableEvents = False
Set s2 = Sheets("Sayfa2")
s2.Cells.ClearContents
With s2.QueryTables.Add(Connection:= _
"URL;file:///" & ThisWorkbook.Path & "/" & Target.Text & ".html", Destination:=s2.Range("$A$1" _
))
.Name = ""
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "1,4,3"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Cells(Target.Row, "B") = s2.Range("C4")
Cells(Target.Row, "C") = s2.Range("C5")
Cells(Target.Row, "D") = s2.Range("C6")
Cells(Target.Row, "E") = s2.Range("C7")
Cells(Target.Row, "F") = s2.Range("F2")
Cells(Target.Row, "u") = s2.Range("c8")
'Cells(Target.Row, "W") = s2.Range("c8")
Cells(Target.Row, "G") = s2.Range("F3")
Cells(Target.Row, "H") = s2.Range("F4")
Cells(Target.Row, "I") = s2.Range("C2")
Cells(Target.Row, "J") = s2.Range("A12")
Cells(Target.Row, "K") = s2.Range("B12")
Cells(Target.Row, "N") = s2.Range("e12")
Cells(Target.Row, "O") = s2.Range("f12")
Cells(Target.Row, "P") = s2.Range("g12")
Cells(Target.Row, "Q") = s2.Range("H12")
Cells(Target.Row, "R") = s2.Range("a21")
Cells(Target.Row, "S") = s2.Range("D21")
Application.EnableEvents = True
End Sub
