Lỗi VBA do webiste ngày sai

[lehaiyenno1]

em có cái file VBA sai lỗi error 1004 do ngày nó bị sai từ ngày =04/04/2015 sang 04-04-2015 là chuẩn mà webiste nó thay link chả biết chỉnh sao đc
code nó đây bác nào chỉnh lại cho em với Sub AutoCapNhatKQ()Dim nName As Name, i As Long
For Each nName In Names
If InStr(1, nName.RefersTo, "#REF!") > 0 Then
nName.Delete
End If
Next
For i = 1 To CAPNHAT.[B4]
If CAPNHAT.[B4] = 0 Then
Exit Sub
End If
CAPNHAT.Rows("20:50").Delete
With CAPNHAT.QueryTables.Add(Connection:= _
"URL;http://ketqua.vn/xo-so-truyen-thong.php?ngay=" & CAPNHAT.[B5], Destination:= _
CAPNHAT.Range("$A$20"))
.Name = "2012_1"
.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 = "3"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
With [SoLieu!a65500].End(xlUp).Offset(1)
.NumberFormat = "dd/mm/yyyy"
.Resize(9, 7).Value = CAPNHAT.[j6].Resize(9, 7).Value
End With
KQCN.Range("J1") = KQCN.Range("J1") + 1
If Weekday(KQCN.Range("A" & KQCN.Range("A10000").End(xlUp).Row - 8)) = 1 Then
KQCN.Range("B" & KQCN.Range("A10000").End(xlUp).Row - 8) = "CN"
Else
KQCN.Range("B" & KQCN.Range("A10000").End(xlUp).Row - 8) = "T" & Weekday(KQCN.Range("A" & KQCN.Range("A10000").End(xlUp).Row - 8))
End If
Next i


CAPNHAT.Rows("20:50").Delete
KQCN.UsedRange.Columns.AutoFit
KQCN.UsedRange.Rows.AutoFit
KQCN.Range("J1") = "=H1+1"
End Sub
Public Sub AutoData()
Dim Nguon, Kq() As String, d As Long, r As Long, c As Long, i As Long, j As Long
Nguon = KQCN.Range("A2:G" & KQCN.Range("A1000000").End(xlUp).Row)
ReDim Kq(1 To UBound(Nguon) / 9, 1 To 28)


For d = 1 To UBound(Nguon) - 8 Step 9
j = 0
i = i + 1
data.Cells(i + 3522, 1) = Nguon(d, 1)
Kq(i, 1) = Nguon(d, 2)
For r = d + 1 To d + 8
For c = 2 To 7
If Nguon(r, c) <> "" Then
j = j + 1
Kq(i, j + 1) = Right("0000000" & Nguon(r, c), data.Cells(1, j + 2).Value)
End If
Next c
Next r
Next d


data.Range("B3523").Resize(UBound(Kq), 28).Value = Kq
data.Range("A3:A" & data.Range("A1000000").End(xlUp).Row).NumberFormat = "dd-mm-yyyy"
data.UsedRange.Columns.AutoFit
End Sub
Public Sub CnData()
Dim rWs, Cols, i As Long
i = 3448
For rWs = 3449 To data.Range("B10000").End(3).Row
i = i + 1
For Cols = 30 To 56
data.Cells(i, Cols) = Right(data.Cells(rWs, Cols - 27), 2)
Next Cols
Next rWs
End Sub
Sub AutoCNKQ()
Dim rW, i As Long
SpeedOn
For rW = 1 To data.Range("B10000").End(3).Row - 1
For i = 4 To Range("A10000").End(3).Row
If Cells(i, 1) = data.Cells(rW, 1) Then
Trc1 = WorksheetFunction.CountIf(data.Range("AD" & rW + 1 & ":BD" & rW + 1), CDbl(Left(Cells(i, "E"), 2)))
Sau1 = WorksheetFunction.CountIf(data.Range("AD" & rW + 1 & ":BD" & rW + 1), CDbl(Right(Cells(i, "E"), 2)))
Trc2 = WorksheetFunction.CountIf(data.Range("AD" & rW + 2 & ":BD" & rW + 2), CDbl(Left(Cells(i, "E"), 2)))
Sau2 = WorksheetFunction.CountIf(data.Range("AD" & rW + 2 & ":BD" & rW + 2), CDbl(Right(Cells(i, "E"), 2)))
Trc3 = WorksheetFunction.CountIf(data.Range("AD" & rW + 3 & ":BD" & rW + 3), CDbl(Left(Cells(i, "E"), 2)))
Sau3 = WorksheetFunction.CountIf(data.Range("AD" & rW + 3 & ":BD" & rW + 3), CDbl(Right(Cells(i, "E"), 2)))
Trc4 = WorksheetFunction.CountIf(data.Range("AD" & rW + 4 & ":BD" & rW + 4), CDbl(Left(Cells(i, "E"), 2)))
Sau4 = WorksheetFunction.CountIf(data.Range("AD" & rW + 4 & ":BD" & rW + 4), CDbl(Right(Cells(i, "E"), 2)))
Trc5 = WorksheetFunction.CountIf(data.Range("AD" & rW + 5 & ":BD" & rW + 5), CDbl(Left(Cells(i, "E"), 2)))
Sau5 = WorksheetFunction.CountIf(data.Range("AD" & rW + 5 & ":BD" & rW + 5), CDbl(Right(Cells(i, "E"), 2)))
If Trc1 + Sau1 > 0 Then
Select Case Trc1 + Sau1
Case 1
Cells(i, "S") = "N1"
Case 2
Cells(i, "S") = "N1**"
Case 3
Cells(i, "S") = "N1***"
Case 4
Cells(i, "S") = "N1****"
Case 5
Cells(i, "S") = "N1*****"
End Select
ElseIf Trc2 + Sau2 > 0 Then
Select Case Trc2 + Sau2
Case 1
Cells(i, "S") = "N2"
Case 2
Cells(i, "S") = "N2**"
Case 3
Cells(i, "S") = "N2***"
Case 4
Cells(i, "S") = "N2****"
Case 5
Cells(i, "S") = "N2*****"
End Select
ElseIf Trc3 + Sau3 > 0 Then
Select Case Trc3 + Sau3
Case 1
Cells(i, "S") = "N3"
Case 2
Cells(i, "S") = "N3**"
Case 3
Cells(i, "S") = "N3***"
Case 4
Cells(i, "S") = "N3****"
Case 5
Cells(i, "S") = "N3*****"
End Select
ElseIf Trc4 + Sau4 > 0 Then
Select Case Trc4 + Sau4
Case 1
Cells(i, "S") = "N4"
Case 2
Cells(i, "S") = "N4**"
Case 3
Cells(i, "S") = "N4***"
Case 4
Cells(i, "S") = "N4****"
Case 5
Cells(i, "S") = "N4*****"
End Select
ElseIf Trc5 + Sau5 > 0 Then
Select Case Trc5 + Sau5
Case 1
Cells(i, "S") = "N5"
Case 2
Cells(i, "S") = "N5**"
Case 3
Cells(i, "S") = "N5***"
Case 4
Cells(i, "S") = "N5****"
Case 5
Cells(i, "S") = "N5*****"
End Select
End If
End If
Next i
Next rW
SpeedOff
End Sub






link chuẩn mới http://ketqua.vn/kqxstt-ket-qua-xo-s...gay-04-04-2015 nản quá
file link đây ạ :http://www.mediafire.com/download/l6...Giai-Full.xlsm sửa đc thì up lên giúp em hoặc gửi email giúp em nhé nicklehaiyenno1@gmail.com