Sửa macro get data from web

Liên hệ QC
H

huybo

Thành viên hoạt động
Tham gia
24/4/13
Bài viết
115
Được thích
5
Sub Macro1()
Range("A1").Select
ActiveCell.FormulaR1C1 = _
"http://s.cafef.vn/bao-cao-tai-chinh/SJD/BSheet/2016/2/0/1/1/bao-cao-tai-chinh-cong-ty-co-phan-thuy-dien-can-don.chn"
Sheets("Load").Select
Application.Goto Reference:="Bang1"
Range("B3").Select
With Selection.QueryTable
.Connection = _
"URL;http://s.cafef.vn/bao-cao-tai-chinh/SJD/BSheet/2016/2/0/1/1/bao-cao-tai-chinh-cong-ty-co-phan-thuy-dien-can-don.chn"
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """tblGridData"",""tableContent"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End Sub
Tại ô a1(sheet1) e để 1 đường link web. sau đó làm macro để copy link tại ô a1(sheet1) đó và paste vào Address của get data from web để lấy dữ liệu về sheet2. Mục đích của e là muốn ô a1 là ô e có thể thay thế 1 đường link bất kỳ nào khác và chạy macro để load dữ liệu về theo đường link mới, nhưng macro chỉ nhận duy nhất 1 đường link ban đầu e tạo macro. Mọi người giúp e chỉnh sửa đoạn code trên với nhé.
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
huybo đã viết:
Sub Macro1()
Range("A1").Select
ActiveCell.FormulaR1C1 = _
"http://s.cafef.vn/bao-cao-tai-chinh/SJD/BSheet/2016/2/0/1/1/bao-cao-tai-chinh-cong-ty-co-phan-thuy-dien-can-don.chn"
Sheets("Load").Select
Application.Goto Reference:="Bang1"
Range("B3").Select
With Selection.QueryTable
.Connection = _
"URL;http://s.cafef.vn/bao-cao-tai-chinh/SJD/BSheet/2016/2/0/1/1/bao-cao-tai-chinh-cong-ty-co-phan-thuy-dien-can-don.chn"
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """tblGridData"",""tableContent"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End Sub
Tại ô a1(sheet1) e để 1 đường link web. sau đó làm macro để copy link tại ô a1(sheet1) đó và paste vào Address của get data from web để lấy dữ liệu về sheet2. Mục đích của e là muốn ô a1 là ô e có thể thay thế 1 đường link bất kỳ nào khác và chạy macro để load dữ liệu về theo đường link mới, nhưng macro chỉ nhận duy nhất 1 đường link ban đầu e tạo macro. Mọi người giúp e chỉnh sửa đoạn code trên với nhé.
Nhấp chuột vào đây để mở rộng...
Bạn thử với .Connection = Range("A1").value
 
Upvote 0
mình vừa sửa connection như ý bạn. và thay 1 link mới và ô a1. nhưng chạy thì báo lỗi appplication defined or object - defined error. quay lại kiểm tra xem ô a1 thì lại thấy trả về đường link cũ
 
Upvote 0
huybo đã viết:
mình vừa sửa connection như ý bạn. và thay 1 link mới và ô a1. nhưng chạy thì báo lỗi appplication defined or object - defined error. quay lại kiểm tra xem ô a1 thì lại thấy trả về đường link cũ
Nhấp chuột vào đây để mở rộng...
Ko hiểu ý bạn,
Mình ko để ý kĩ Bạn sửa thành
.Connection = sheets(1).Range("A1").value
 
Upvote 0
Xoá dòng này:
PHP: 
Range("A1").Select
ActiveCell.FormulaR1C1 = _
        "http://s.cafef.vn/bao-cao-tai-chinh/SJD/BSheet/2016/2/0/1/1/bao-cao-tai-chinh-cong-ty-co-phan-thuy-dien-can-don.chn"
thay bằng:
PHP: 
Dim link as string
link=Range("A1").value
Và
PHP: 
.Connection = link
 
Upvote 0
Sub Macro2()
'Range("A1").Select
'ActiveCell.FormulaR1C1 = _
"http://s.cafef.vn/bao-cao-tai-chinh/SJD/BSheet/2016/2/0/1/1/bao-cao-tai-chinh-cong-ty-co-phan-thuy-dien-can-don.chn"
Dim link As String
link = Range("A1").Value
Sheets("Load").Select
Application.Goto Reference:="Bang1"
Range("B3").Select
With Selection.QueryTable
.Connection = link
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """tblGridData"",""tableContent"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End Sub
vẫn báo lỗi bác ạ
 
Upvote 0
E gửi file lên để các bác giúp e cho tiện
 

File đính kèm

  • Cafef11111111111111.xlsm
    34.1 KB · Đọc: 13
Upvote 0
Sub Macro1()
' Macro1 Macro
Dim link1 As String
link1 = Range("D7").Value
Sheets("Load").Select
Application.Goto Reference:="Bang1"
Range("B3").Select
With Selection.QueryTable
.Connection = "URL;" & link1
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """tblGridData"",""tableContent"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Sheets("Fa").Select
Dim link2 As String
link2 = Range("D2").Value
Sheets("Load").Select
Application.Goto Reference:="Bang2"
Range("B246").Select
With Selection.QueryTable
.Connection = "URL;" & link2
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """tblGridData"",""tableContent"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Sheets("Fa").Select
Dim link3 As String
link3 = Range("D3").Value
Sheets("Load").Select
Application.Goto Reference:="Bang3"
Range("B297").Select
With Selection.QueryTable
.Connection = "URL;" & link3
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """tblGridData"",""tableContent"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Sheets("Fa").Select
Dim link4 As String
link4 = Range("D").Value
Sheets("Load").Select
Application.Goto Reference:="Bang4"
Range("B348").Select
With Selection.QueryTable
.Connection = "URL;" & link4
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """tblGridData"",""tableContent"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Sheets("Fa").Select
Range("B9").Select
End Sub
E copy thêm 3 đoạn code nữa nhưng chạy macro ko được, e làm máy móc thế này không biết sai chỗ nào. mong 2 bác chỉ giáo thêm ạ
 
Upvote 0
huybo đã viết:
Sub Macro1()
' Macro1 Macro
Dim link1 As String
link1 = Range("D7").Value
Sheets("Load").Select
Application.Goto Reference:="Bang1"
Range("B3").Select
With Selection.QueryTable
.Connection = "URL;" & link1
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """tblGridData"",""tableContent"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Sheets("Fa").Select
Dim link2 As String
link2 = Range("D2").Value
Sheets("Load").Select
Application.Goto Reference:="Bang2"
Range("B246").Select
With Selection.QueryTable
.Connection = "URL;" & link2
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """tblGridData"",""tableContent"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Sheets("Fa").Select
Dim link3 As String
link3 = Range("D3").Value
Sheets("Load").Select
Application.Goto Reference:="Bang3"
Range("B297").Select
With Selection.QueryTable
.Connection = "URL;" & link3
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """tblGridData"",""tableContent"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Sheets("Fa").Select
Dim link4 As String
link4 = Range("D").Value
Sheets("Load").Select
Application.Goto Reference:="Bang4"
Range("B348").Select
With Selection.QueryTable
.Connection = "URL;" & link4
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """tblGridData"",""tableContent"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Sheets("Fa").Select
Range("B9").Select
End Sub
E copy thêm 3 đoạn code nữa nhưng chạy macro ko được, e làm máy móc thế này không biết sai chỗ nào. mong 2 bác chỉ giáo thêm ạ
Nhấp chuột vào đây để mở rộng...
Bạn phải cho biết nó lỗi ntn và lỗi ở đâu chứ.
Bạn sửa lại chỗ này
link4 = Range("D").Value

thành
link4 = Range("D4").Value
 
Upvote 0
Cám ơn bác. E phát hiện ra lỗi của mình rồi ạ. các cell d2 d3... của e nhầm công thức
 
Upvote 0
Cám ơn bác. E phát hiện ra lỗi của mình rồi ạ. các cell d2 d3... của e nhầm công thức
 
Upvote 0
Sub Macro3()
'
' Macro3 Macro
'


'
Dim link1 As String
link1 = Range("C1").Value
'Range("E1").Select
'ActiveCell.FormulaR1C1 = _
"http://s.cafef.vn/bao-cao-tai-chinh/D2D/IncSta/2016/2/0/0/3/ket-qua-hoat-dong-kinh-doanh-cong-ty-co-phan-phat-trien-do-thi-cong-nghiep-so-2.chn"
Sheets("Load").Select
Application.Goto Reference:="Bang1"
Range("B2").Select
With Selection.QueryTable
.Connection = "URL;" & link1
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """tblGridData"",""tableContent"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Dim link2 As String
link2 = Range("C2").Value
'Sheets("Fa").Select
'Range("E2").Select
'ActiveCell.FormulaR1C1 = _
"http://s.cafef.vn/bao-cao-tai-chinh/D2D/IncSta/2016/2/2/1/1/ket-qua-hoat-dong-kinh-doanh-cong-ty-co-phan-phat-trien-do-thi-cong-nghiep-so-2.chn"
Sheets("Load").Select
Application.Goto Reference:="Bang2"
Range("N2").Select
With Selection.QueryTable
.Connection = "URL;" & link2
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """tblGridData"",""tableContent"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Dim link3 As String
link3 = Range("C3").Value
'Sheets("Fa").Select
'Range("E3").Select
'ActiveCell.FormulaR1C1 = _
"http://s.cafef.vn/bao-cao-tai-chinh/D2D/IncSta/2015/2/6/1/1/ket-qua-hoat-dong-kinh-doanh-cong-ty-co-phan-phat-trien-do-thi-cong-nghiep-so-2.chn"
Sheets("Load").Select
Application.Goto Reference:="Bang3"
Range("Z2").Select
With Selection.QueryTable
.Connection = "URL;" & link3
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """tblGridData"",""tableContent"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Dim link4 As String
link4 = Range("C4").Value
'Sheets("Fa").Select
'Range("E4").Select
'ActiveCell.FormulaR1C1 = _
"http://s.cafef.vn/bao-cao-tai-chinh/D2D/IncSta/2014/2/10/0/ket-qua-hoat-dong-kinh-doanh-cong-ty-co-phan-phat-trien-do-thi-cong-nghiep-so-2.chn"
Sheets("Load").Select
Application.Goto Reference:="Bang4"
Range("AL2").Select
With Selection.QueryTable
.Connection = "URL;" & link4
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """tblGridData"",""tableContent"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Dim link5 As String
link5 = Range("C6").Value
'Sheets("Fa").Select
'Range("E6").Select
'ActiveCell.FormulaR1C1 = _
"http://s.cafef.vn/bao-cao-tai-chinh/D2D/IncSta/2016/0/0/1/0/ket-qua-hoat-dong-kinh-doanh-cong-ty-co-phan-phat-trien-do-thi-cong-nghiep-so-2.chn"
Sheets("Load").Select
Application.Goto Reference:="Bang5"
Range("AX2").Select
With Selection.QueryTable
.Connection = "URL;" & link5
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """tblGridData"",""tableContent"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Dim link6 As String
link6 = Range("C7").Value
'Sheets("Fa").Select
'Range("E7").Select
'ActiveCell.FormulaR1C1 = _
"http://s.cafef.vn/bao-cao-tai-chinh/D2D/BSheet/2016/2/0/1/1/bao-cao-tai-chinh-cong-ty-co-phan-phat-trien-do-thi-cong-nghiep-so-2.chn"
Sheets("Load").Select
Application.Goto Reference:="Bang6"
Range("B55").Select
With Selection.QueryTable
.Connection = "URL;" & link6
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """tblGridData"",""tableContent"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Dim link7 As String
link7 = Range("C8").Value
'Sheets("Fa").Select
'Range("E8").Select
'ActiveCell.FormulaR1C1 = _
"http://s.cafef.vn/bao-cao-tai-chinh/D2D/CashFlow/2016/2/0/1/1/luu-chuyen-tien-te-gian-tiep-cong-ty-co-phan-phat-trien-do-thi-cong-nghiep-so-2.chn"
Sheets("Load").Select
Application.Goto Reference:="Bang7"
Range("Z55").Select
With Selection.QueryTable
.Connection = "URL;" & link7
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = """tblGridData"",""tableContent"""
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

Sheets("Fa").Select
End Sub

Lại xin làm phiền Bác quanluu và mọi người, e lại bị lỗi tô màu đỏ, tìm hiểu mãi cách sửa mà chưa đc, giúp e với.
 
Upvote 0
Bác nào có code để get data from web thì chỉ giáo cho e? e mới chỉ làm dựa vào record macro
 
Upvote 0
huybo đã viết:
Sub Macro3()
'

Lại xin làm phiền Bác quanluu và mọi người, e lại bị lỗi tô màu đỏ, tìm hiểu mãi cách sửa mà chưa đc, giúp e với.
Nhấp chuột vào đây để mở rộng...

Bạn thay False thành True nhé, vì nếu để False thì cái thứ 1 chưa chạy xong thì cái thứ 2 đã chạy nên báo lỗi, để true thì nó chạy xong link 1 rùi chạy link 2
Còn code get data từ web thì bạn chịu khó search mạng thui, Mình nghĩ trên mạng có mà đầy.
 
Upvote 0
tks bác, số e đang nhọ, mấy file excel đều bị dính lỗi[h=1]excel found unreadable content[/h]nên chưa vào thử dc, bực quá
 
Upvote 0
e chuyển false thành true r nhưng vẫn báo lỗi ở đó, lúc thì báo lỗi ở dòng With Selection.QueryTable
 
Upvote 0
mình có kiểm tra trong data -> connection thì có 7 connection tương ứng 7 lần get data. kiểm tra tiếp properties -> definition thì có 2 cái bị mất connection string ( chính là đường link web). và mình lỗi code của mình thì chỉ quanh đoạn 2 cái này. các bác sửa giúp e với nhé
 
Upvote 0
Mấy anh chị cho em hỏi về cách lấy thông tin từ 1 trang web mà mình phải đăng nhập thì code như thế nào ạ?
VD: trong trang "https://www.giaiphapexcel.com", em cần đăng nhập và lấy số tin nhắn như trong hình. Do cái chỗ hiển thị số tin nhắn đó không có ID, nên em ko biết phải lấy thế nào. Mong được giúp đỡ.Untitled.png
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

N
  • Question
Mở từng file PDF ra in rồi đóng lại mở tiếp file khác trên cùng folder
Trả lời
13
Đọc
163
Hoàng Tuấn 868
H
A
Tính tổng dữ liệu băng dictionary
Trả lời
8
Đọc
147
HieuCD
H
vancuong4747
Chuyển đổi chữ tiếng Nhật từ ký tự toàn phần thành ký tự bán phần.
Trả lời
0
Đọc
22
vancuong4747
vancuong4747
LuuAnh980
  • Question
Code lấy dữ liệu từ 3 file con.
2 3 4
Trả lời
68
Đọc
1K
Hoàng Tuấn 868
H
LuuAnh980
Công thức thỏa mãn 2 điều kiện thì có dấu X, nếu không thì =""
Trả lời
15
Đọc
133
Hoàng Tuấn 868
H
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom