làm thế nào chỉ phủ khối là có thế copy vào excel không nhỉ

Liên hệ QC
ongtrungducmx25

ongtrungducmx25

Thành viên gạo cội
Tham gia
5/2/07
Bài viết
2,077
Được thích
1,986
Nghề nghiệp
GV
em muốn viết code để phủ khối một vùng trang web này và em viết code để copy vào bảng tính cho nhanh, không biết làm như thế nào ,nếu mà phủ khối một vùng mà không chọn copy và đem vào past trong excel thì viết code như thế nào nhỉ!
em tạm viết thử là
PHP: 
Private Sub CheckBox5_Click()
ActiveSheet.Paste
    Columns("A:A").ColumnWidth = 14
    Columns("B:B").ColumnWidth = 47
    Rows("1:1").EntireRow.AutoFit
    Rows("4:4").EntireRow.AutoFit
    Rows("6:6").EntireRow.AutoFit
    Rows("7:7").EntireRow.AutoFit    
End Sub
Tên Giải​
​
|
Vĩnh Long - Ký hiệu: 29VL-37​
​
|
50 Ngàn|
96​
|
100 ngàn|
995​
|
200 ngàn|1195 - 8320 - 1776|
500 ngàn|
7223​
|
1 triệu 500 ngàn|53150 - 67135 - 38175 - 04797 - 60499 - 22372 - 41435|
5 triệu|93544 - 59029|
8 triệu|
13914​
|
12 triệu|
56817​
|
125 triệu|
89555​
|
 
ongtrungducmx25 đã viết:
em muốn viết code để phủ khối một vùng trang web này và em viết code để copy vào bảng tính cho nhanh, không biết làm như thế nào ,nếu mà phủ khối một vùng mà không chọn copy và đem vào past trong excel thì viết code như thế nào nhỉ!
Nhấp chuột vào đây để mở rộng...
Bạn phủ khối một phần trang web thì phải chọn bằng chuột chứ sao lại viết code. Đây là môi trường của IE chứ đâu phải của Excel. Mà nếu có thể được, biết ý bạn chọn cái gì, phải làm thầy bói ả? Vả lại, động tác rê chuột chọn bảng trên trang web > Ctrl+C là quá đơn giản rồi cần gì code

PHP: 
Private Sub CheckBox5_Click()
ActiveSheet.Paste
    Columns("A:A").ColumnWidth = 14
    Columns("B:B").ColumnWidth = 47
    Rows("1:1").EntireRow.AutoFit
    Rows("4:4").EntireRow.AutoFit
    Rows("6:6").EntireRow.AutoFit
    Rows("7:7").EntireRow.AutoFit    
End Sub
Mỗi bảng tính bạn chọn khác nhau. Không thể có số 14, 47, "1:1", ... cụ thể được. Phải dùng cái chung là Selection.

Đây là một ví dụ, sau khi copy xong, bạn đưa con trỏ vào nơi cần paste trên bảng tính và chạy PasteeTable, nó xóa định dạng của trang web, kẻ khung và chỉnh tự động độ rộng cột
Mã: 
Sub PastTable()
ActiveSheet.Paste
Selection.ClearFormats
Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous
Selection.Borders(xlEdgeTop).LineStyle = xlContinuous
Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous
Selection.Borders(xlEdgeRight).LineStyle = xlContinuous
Selection.Borders(xlInsideVertical).LineStyle = xlContinuous
Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous
Selection.Columns.AutoFit
End Sub
 
thầy long ơi sao em chép code của thầy vào rồi khi em dán vào thì không thể hiện đúng định dạng nhé!
Tên Giải|An Giang - Ký hiệu: 09K02
50 Ngàn|46
100 ngàn|643
200 ngàn|2058-4812-8848
500 ngàn| 99
1 triệu 500 ngàn|57175-85303-62059-03714-29059-30548-11484
5 triệu|62517-39436
8 triệu|34771
12 triệu|33391
125 triệu|73701

trong khi đó bảng kết quả xổ số là như thế này!
Tên Giải|An Giang - Ký hiệu: 09K02
50 Ngàn|46
100 ngàn|643
200 ngàn|2058-4812-8848
500 ngàn| 0099
1 triệu 500 ngàn|57175-85303-62059-03714-29059-30548-11484
5 triệu|62517-39436
8 triệu|34771
12 triệu|33391
125 triệu|73701
sai ở dòng 500ngàn thầy giúp em định dạng trong các ô đó thành text có được không! nếu lô đầu tiên sổ là :00 thì copy sang nó không có gì cả
hoặc lô tùy ý :00872-11517-14061-17937-89855-58510-33558
khi đó chép qua: 872-11517-14061-17937-89855-58510-33558
 
Gui anh TRUNGDU : Anh bày tôi sử dụng cái code này với

Mã: 
Sub PastTable()
ActiveSheet.Paste
Selection.ClearFormats
Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous
Selection.Borders(xlEdgeTop).LineStyle = xlContinuous
Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous
Selection.Borders(xlEdgeRight).LineStyle = xlContinuous
Selection.Borders(xlInsideVertical).LineStyle = xlContinuous
Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous
Selection.Columns.AutoFit
End Sub
[/quote]
 
Lần chỉnh sửa cuối:
đâu có gì khắc phục được lỗi đâu bạn nhé!

xổ số ngày Ngày 17/09/2008
Tên Giải|Đà Nẳng - Ký hiệu: XSDNg-17-9-08
Giải tám | 6
 Giải bảy |950
Giải sáu |6237 - 1528 - 7095
Giải năm |1495
Giải tư |66521 - 20937 - 85569 - 69010 - 88257 - 74335 - 08753
Giải ba |15910 - 36277
Giải nhì |77339
Giải nhất |73587
Giải đặc biệt |34013

lô đầu là :'06 chép sang thành 6
 
bạn chọn Froms sao đó chọn đối tượng Botton/chen macro vào là chạy được thôi( bạn chọn chuột phải lên thanh menu nhé)
 
kieuhuy_bmt đã viết:
Tôi chép code vào Library, đặt đuôi xla hẳn hoi, song chưa biết chạy thế nào
Nhấp chuột vào đây để mở rộng...
Chép code và Libary nào? Bạn chép trong Module của bảng tính Excel. Sau khi copy bảng bên Web > chọn sheet và bấm chuột vào ô cần dán > Bấm Alt+F8 > chọn tên Macro cần dán > Run
 
Thầy Long ơi có cách nào khắc phục lỗi #5 đó không nhỉ
 
ongtrungducmx25 đã viết:
thầy long ơi sao em chép code của thầy vào rồi khi em dán vào thì không thể hiện đúng định dạng nhé!
Tên Giải|An Giang - Ký hiệu: 09K02
50 Ngàn|46
100 ngàn|643
200 ngàn|2058-4812-8848
500 ngàn| 99
1 triệu 500 ngàn|57175-85303-62059-03714-29059-30548-11484
5 triệu|62517-39436
8 triệu|34771
12 triệu|33391
125 triệu|73701

trong khi đó bảng kết quả xổ số là như thế này!
Tên Giải|An Giang - Ký hiệu: 09K02
50 Ngàn|46
100 ngàn|643
200 ngàn|2058-4812-8848
500 ngàn| 0099
1 triệu 500 ngàn|57175-85303-62059-03714-29059-30548-11484
5 triệu|62517-39436
8 triệu|34771
12 triệu|33391
125 triệu|73701
sai ở dòng 500ngàn thầy giúp em định dạng trong các ô đó thành text có được không! nếu lô đầu tiên sổ là :00 thì copy sang nó không có gì cả
hoặc lô tùy ý :00872-11517-14061-17937-89855-58510-33558
khi đó chép qua: 872-11517-14061-17937-89855-58510-33558
Nhấp chuột vào đây để mở rộng...
Khi copy từ Web và paste vào Excel thì 0099 đã chuyển dạng số 99 rồi (chưa chạy PasteTable). Bạn chỉ có 2 cách:
1. Biết được lô nào sổ mấy số (500 ngàn sổ 4 số), nếu thiếu bù số 0 vào.
2. Viết code nhận dạng lô và tự động bù số 0. Ví dụ lô 500 ngàn có 4 số nhưng chép về có 2 số thì bù thêm 2 số 00 bên trái.
 
ongtrungducmx25 đã viết:
Thầy Long ơi có cách nào khắc phục lỗi #5 đó không nhỉ
Nhấp chuột vào đây để mở rộng...
PasteTable bù thêm số 0 thiếu phía trước:
Mã: 
Sub PastTable()
ActiveSheet.Paste
Selection.ClearFormats
Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous
Selection.Borders(xlEdgeTop).LineStyle = xlContinuous
Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous
Selection.Borders(xlEdgeRight).LineStyle = xlContinuous
Selection.Borders(xlInsideVertical).LineStyle = xlContinuous
Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous
Selection.Columns.AutoFit
rd = Selection.Row
kyhieu = "Ký hi" & ChrW(7879) & "u"
Selection.Find(What:=kyhieu, After:=ActiveCell).Activate
c = ActiveCell.Column
Do
  rkh = Columns(c).Find(What:=kyhieu, After:=Cells(rd, c)).Row
  Cells(rkh, c).Select
  If rkh < rd Then Exit Do
  rd = rkh
  Cells(rkh + 1, c) = "'" & Format(Cells(rkh + 1, c), "00")
  Cells(rkh + 2, c) = "'" & Format(Cells(rkh + 2, c), "000")
  Cells(rkh + 7, c) = "'" & Format(Cells(rkh + 7, c), "00000")
  Cells(rkh + 8, c) = "'" & Format(Cells(rkh + 8, c), "00000")
Loop
End Sub
 

File đính kèm

  • SosoBinhDuong.xls
    43.5 KB · Đọc: 12
Mã: 
Sub PastTable()
ActiveSheet.Paste
Selection.ClearFormats
Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous
Selection.Borders(xlEdgeTop).LineStyle = xlContinuous
Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous
Selection.Borders(xlEdgeRight).LineStyle = xlContinuous
[COLOR=red]Selection.Borders(xlInsideVertical).LineStyle = xlContinuous[/COLOR]
Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous
Selection.Columns.AutoFit
rd = Selection.Row
kyhieu = "Ký hi" & ChrW(7879) & "u"
Selection.Find(What:=kyhieu, After:=ActiveCell).Activate
c = ActiveCell.Column
Do
  rkh = Columns(c).Find(What:=kyhieu, After:=Cells(rd, c)).Row
  Cells(rkh, c).Select
  If rkh < rd Then Exit Do
  rd = rkh
  Cells(rkh + 1, c) = "'" & Format(Cells(rkh + 1, c), "00")
  Cells(rkh + 2, c) = "'" & Format(Cells(rkh + 2, c), "000")
  Cells(rkh + 7, c) = "'" & Format(Cells(rkh + 7, c), "00000")
  Cells(rkh + 8, c) = "'" & Format(Cells(rkh + 8, c), "00000")
Loop
End Sub

code này lại báo lỗi thế thầy Long!
 
ongtrungducmx25 đã viết:
Mã: 
[COLOR=red]Selection.Borders(xlInsideVertical).LineStyle = xlContinuous[/COLOR]
code này lại báo lỗi thế thầy Long!
Nhấp chuột vào đây để mở rộng...
Selection.Borders(xlInsideVertical).LineStyle = xlContinuous kẻ dường thẳng đứng bên trong vùng chọn. Nếu vùng chọn chỉ có 1 cột thì báo lỗi vì không kẻ được.
Bạn thêm dòng này
Mã: 
On Error Resume Next
trên dòng ActiveSheet.Paste để nếu có lỗi thì bỏ qua.
Hỏi thêm bạn: nếu copy từ trang web thì phải 2 cột chứ sao là 1 cột ?
 
Tôi vừa mới viết code truy cập kết quả xổ số đây.
Kết quả xổ số lấy từ trang web xosobinhduong.
Ai có nhu cầu thì dùng thử và cho biết có vấn đề gì không nhé.
Do lấy trực tiếp kết quả từ trên mạng nên chỉ có tác dụng khi đang online.
 

File đính kèm

  • xosobinhduong.xls
    50.5 KB · Đọc: 18
phamduylong đã viết:
Selection.Borders(xlInsideVertical).LineStyle = xlContinuous kẻ dường thẳng đứng bên trong vùng chọn. Nếu vùng chọn chỉ có 1 cột thì báo lỗi vì không kẻ được.
Bạn thêm dòng này
Mã: 
On Error Resume Next
trên dòng ActiveSheet.Paste để nếu có lỗi thì bỏ qua.
Hỏi thêm bạn: nếu copy từ trang web thì phải 2 cột chứ sao là 1 cột ?
Nhấp chuột vào đây để mở rộng...

đúng là copy 2 cột thầy long nhé!
Tên Giải|Bình Phước - Ký hiệu: 9K-3
50 Ngàn|39
100 ngàn|643
200 ngàn|8084 - 9178 - 7620
500 ngàn|2721
1 triệu 500 ngàn|15907 - 72530 - 60329 - 61443 - 50906 - 61647 - 39644
5 triệu|13462 - 13557
8 triệu|25387
12 triệu|91724
125 triệu|06885
sao giải đặt biệt thì không đúng chỉ hiện 6885; em muốn là các lô nếu có sô o đứng trước copy qua bảng tình thì nó tự động điền số o vào , em thấy nó chỉ điền vào lô đâu: 5=>'05 thì đúng , các lô 50 Ngàn;100 Ngàn;500 Ngàn;8 triệu;12 triệu và 125 triệu thì còn sai nhiều lắm thầy xem lại cho em nhé!
 
Lần chỉnh sửa cuối:
Vậy bác dùng tính năng Format Cells xem. Nếu muốn ô nào có định dạng bao nhiêu số thì chỉ việc nhập bấy nhiêu số 0 vào ô Type của mục Custom (Bấm phải chuột vào ô đó chọn Format Cells -> chọn thẻ Number -> Custom -> nhập 000 vào ô Type, nếu muốn ô đó có 3 chữ số. Ví dụ: 015). Tương tư như vậy với các ô có nhiều số hơn.
Format | Ex 000 | 015 0000 | 0015 00000 | 00015
 
Lần chỉnh sửa cuối:
Đúng là viết còn thiếu giải 500.000 và giải đặc biệt. Xin bổ sung thêm:
Mã: 
Sub PastTable()
ActiveSheet.Paste
Selection.ClearFormats
Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous
Selection.Borders(xlEdgeTop).LineStyle = xlContinuous
Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous
Selection.Borders(xlEdgeRight).LineStyle = xlContinuous
Selection.Borders(xlInsideVertical).LineStyle = xlContinuous
Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous
Selection.Columns.AutoFit
rd = Selection.Row
kyhieu = "Ký hi" & ChrW(7879) & "u"
Selection.Find(What:=kyhieu, After:=ActiveCell).Activate
c = ActiveCell.Column
'Bu so 0
Do
  rkh = Columns(c).Find(What:=kyhieu, After:=Cells(rd, c)).Row
  Cells(rkh, c).Select
  If rkh < rd Then Exit Do
  rd = rkh
  Cells(rkh + 1, c) = "'" & Format(Cells(rkh + 1, c), "00") [COLOR=blue]'50 ngan[/COLOR]
  Cells(rkh + 2, c) = "'" & Format(Cells(rkh + 2, c), "000") [COLOR=blue]'100 ngan[/COLOR]
  Cells(rkh + 4, c) = "'" & Format(Cells(rkh + 4, c), "0000") [COLOR=blue]'500 ngan[/COLOR]
  Cells(rkh + 7, c) = "'" & Format(Cells(rkh + 7, c), "00000") [COLOR=blue]'8 trieu[/COLOR]
  Cells(rkh + 8, c) = "'" & Format(Cells(rkh + 8, c), "00000") [COLOR=blue]'12 trieu[/COLOR]
  Cells(rkh + 9, c) = "'" & Format(Cells(rkh + 9, c), "00000") [COLOR=blue]'125 trieu[/COLOR]
Loop
End Sub
 
to ongtrungducmx25 :
 

File đính kèm

  • xosobinhduong2.xls
    63 KB · Đọc: 15
Làm thế nào để chạy được code này như Add-Ins

Các hynh ơi! tôi thấy việc sử dụng cái code trên đâu chỉ dùng trong việc theo dõi sổ số. Vì vậy nhờ các huynh hướng dẫn giúp chuyển Code trên để chạy cho tất cả các Worksheet khi cần cho cả việc khác.
 
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

C
Giúp em viết công thức làm lịch thi đấu.
Trả lời
3
Đọc
48
VetMini
V
pupuchcha
  • Question
Viết code để tìm xích ma, mong mọi người giúp đỡ em ạ
Trả lời
4
Đọc
81
VetMini
V
C
  • Question
Tạo schedule chạy code VBA
Trả lời
8
Đọc
252
VetMini
V
V
Tách chuỗi bất kỳ vào các cột khi gặp ký tự -
Trả lời
6
Đọc
185
Duy Tùng 9x
Duy Tùng 9x
LuuAnh980
Filter lọc có "mm" mà không thấy.
Trả lời
2
Đọc
48
CHAOQUAY
C
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