làm thế nào chỉ phủ khối là có thế copy vào excel không nhỉ (2 người xem)

[ongtrungducmx25]

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à

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​

|

 

[phamduylong]

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ỉ!

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

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

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

 

[ongtrungducmx25]

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

 

[kieuhuy_bmt]

Gui anh TRUNGDU : Anh bày tôi sử dụng cái code này với

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]

 

[ongtrungducmx25]

đâ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

 

[kieuhuy_bmt]

Anh Long ơi! chạy PasteeTable là thế nào?

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
http://images4.dantri.com.vn/Uploaded/nguyenhuong/thang102007/hinh2a.jpg

 

[ongtrungducmx25]

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é)

 

[phamduylong]

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

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

 

[ongtrungducmx25]

Thầy Long ơi có cách nào khắc phục lỗi #5 đó không nhỉ

 

[phamduylong]

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

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.

 

[phamduylong]

Thầy Long ơi có cách nào khắc phục lỗi #5 đó không nhỉ

PasteTable bù thêm số 0 thiếu phía trước:

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

 

[ongtrungducmx25]

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!

 

[phamduylong]

[COLOR=red]Selection.Borders(xlInsideVertical).LineStyle = xlContinuous[/COLOR]

code này lại báo lỗi thế thầy Long!

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

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 ?

 

[lypt]

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.

 

[ongtrungducmx25]

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

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 ?

đú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é!

 

[Po_Pikachu]

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

 

[phamduylong]

Đúng là viết còn thiếu giải 500.000 và giải đặc biệt. Xin bổ sung thê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

 

[lypt]

to ongtrungducmx25 :

 

[kieuhuy_bmt]

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.