Bài tập VBA - Macro (1 người xem)

handung107 · 10/6/06

1) Tạo Macro
Tạo Macro có tên "Dinhdang" ghi lại một hành động Format (màu, loại font, cỡ,..)
Gán Macro "Dinhdang" lên thanh Toolbar (không yêu cầu dùng VBA), dùng với phương pháp "ustomize...".
Định dạng một số ô bằng Macro "Dinhdang"
2) Đọc hiểu Macro
Mở xem nội dung của Macro "Dinhdang" (ALT+F11)
Giải thích từng dòng lệnh
Bản chất của một Macro là một Sub (thủ tục)?
3) Có mấy cách để chạy được một Macro? Nội dung của các cách?
4) Tạo một Macro định dạng bảng, giải thích từng dòng lệnh của Macro đó.
5) Tạo một Macro để dán giá trị (Paste Value)
Ứng dụng: Khi cần copy giá trị của một công thức, bạn chọn lệnh Copy sau đó đặt con trỏ vào địa chỉ cần dán dữ liệu và chạy Macro trên.
6) Tạo một Macro định dạng số tiền về dạng "#,##0"
7) Tạo một Macro định dạng ngày tháng về dạng "dd/MM/yy"
8) Tạo một Macro dán định dạng (Paste Formats)
9) Tạo một Macro để xoay chiều giá trị
Ứng dụng: Khi cần xoay các giá trị nằm theo hàng thành theo cột.
10) Tạo một thanh công cụ (Toolbar) có tên "Các lệnh của tôi". Trên thanh toolbar gán tất cả các Macro đã tạo từ câu 1-9 đặt tên rõ ràng theo nội dung công việc.

Huy vọng các bạn làm tốt và tự rút ra được nhiều điều từ việc Record một Macro, đọc hiểu các câu lệnh của VBA .

ngocnam · 14/11/06

cho xem bài giải đi, em không biết làm...

Pansy_flower · 14/11/06

ngocnam đã viết:
cho xem bài giải đi, em không biết làm...

Để làm được bài này, bạn qua box Học tập Offline down các bài sau về đọc:

-Tài liệu buổi học VBA đầu tiên

-Tài liệu buổi học VBA thứ hai

-Tài liệu buổi học VBA thứ ba

-Tài liệu buổi học VBA thứ tư

ngo15 · 14/6/07

Tôi làm bài tập 5 của chị handung107, nhưng khi chạy cứ báo lỗi.
Tôi ghi lại lần lượt đã làm như sau: chọn vùng cần copy, copy, chọn một ô sẽ paste, ghi macro, edit, paste special, value, stop ghi macro.
Và kết quả như sau: "Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks :=False, Transpose:=False".
Các bạn làm ơn chỉ lỗi ở đâu?
Xin chân thành cám ơn.

ThuNghi · 14/6/07

Phải ghi macro ngay khi chọn vùng cần copy - Value, Stop
Chớ ghi macro từ lúc dán thì lấy gì mà dán.

Sub Macro1()
' Macro1 Macro
'copy
Range("A1:A6").Select
Selection.Copy
'chon vùng dán
Range("D1").Select
'dán
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'thoát copy
Application.CutCopyMode = False
'đến lúc nào không còn hiểu gì hết là thành công => đi thuê
End Sub

Mr Okebab · 14/6/07

Nên bỏ đi thủ tục Selection ThuNghi ạ

Mã:

Sub Macro1()

Range("A1:A6").Copy
Range("D1").PasteSpecial Paste:=xlPasteValues

    Application.CutCopyMode = False
End Sub

Thân!

ThuNghi · 14/6/07

Đây là dùng VBA theo cách ABC, phai từ đơn giản.

ngo15 · 14/6/07

Theo như bạn ThuNghi thì vùng copy và paste là cố định. Nhưng tôi muốn copy một vùng bất kỳ và paste vào một vùng bất kỳ khác thì làm thế nào?

ThuNghi · 14/6/07

Dù bất kỳ thế nào bạn cũng phải chỉ cho chỗ cần copy và chỗ cần Paste chớ.
Chắc mình chưa hiểu ý bạn!

ngo15 · 14/6/07

Ý của tôi là tôi copy chẳng hạn D10:E15 rồi paste vào F100, một lúc sau tôi lại copy C2:G10 paste vào A24, hoặc copy từ range của sheet khác paste vào sheet này ... Tóm lại là tôi copy một vùng dữ liệu nào đó trước, sau đó chọn cell đầu tiên của vùng cần paste rồi mới chạy Macro "Paste value".

Tôi nhắc lại đề bài của chị handung107:
"5) Tạo một Macro để dán giá trị (Paste Value)
Ứng dụng: Khi cần copy giá trị của một công thức, bạn chọn lệnh Copy sau đó đặt con trỏ vào địa chỉ cần dán dữ liệu và chạy Macro trên."

Mr Okebab · 14/6/07

ngo15 đã viết:
Ý của tôi là tôi copy chẳng hạn D10:E15 rồi paste vào F100, một lúc sau tôi lại copy C2:G10 paste vào A24, hoặc copy từ range của sheet khác paste vào sheet này ... Tóm lại là tôi copy một vùng dữ liệu nào đó trước, sau đó chọn cell đầu tiên của vùng cần paste rồi mới chạy Macro "Paste value".

Quá trình Copy --> Paste đòi hỏi không được gián đoạn.

Khi copy tức là máy đã nạp vào bộ nhớ tạm của nó dũ liệu copy. Vì vậy cần chú ý đến các hành động và sự kiện có thể làm mất vùng tạm này, đặc biệt là sự kiện Workbook Change Selection.

Có lẽ bạn nên gửi File đó lên để mọi người tìm hiểu.

Thân!

nvson · 14/6/07

ngo15 đã viết:
Ý của tôi là tôi copy chẳng hạn D10:E15 rồi paste vào F100, một lúc sau tôi lại copy C2:G10 paste vào A24, hoặc copy từ range của sheet khác paste vào sheet này ... Tóm lại là tôi copy một vùng dữ liệu nào đó trước, sau đó chọn cell đầu tiên của vùng cần paste rồi mới chạy Macro "Paste value".

oh, vậy thì bạn không nên dùng chức năng Copy - Paste vì nếu làm nhiều lần chương trình sẽ rất chậm!
Bạn tạo 2 biến kiểu Range: 1 biến là vùng dữ liệu nguồn, 1 biến là vùng dữ liệu đích.

Mã:

Dim rngSource As Range
Dim rngDest As Range
Set rngDest = Range(....)
With rngSource
            Set rngDest = basebook.ActiveSheet.Cells(.....).Resize(.Rows.Count, .Columns.Count)
End With
rngDest.Value = rngSource.Value
......

Bạn tham khảo thêm bài "Lấy Thông Tin Từ File Không Mở " #22 nhé!

ngo15 · 15/6/07

Tôi làm bài tập số 5 của chị handung107và thấy trong thực tế nhiều lúc cũng cần copy một vùng từ file khác paste value sang file này nên hỏi chứ không có file cụ thể (Không phải dữ liệu nguồn và đích cố định). Tôi cũng đoán có thể không có lệnh copy trong Macro nên nó không biết Paste cái gì. Tóm lại tôi chỉ muốn thay lệnh: Edit/Paste Special/Valume/OK thành một Ctrl+Shift+P chẳng hạn.

ThuNghi · 15/6/07

Cái này thì bản thân excel đã có, bạn vào View, toolbars, customize (dòng cuối), tiếp tục chọn Commands, bên khung bên trái chọn Edit, bên phải tìm Paste Values (icon có hình số 12), click chuột vào vào kéo lên thanh trên cùng. Lần sau khi copy bạn muốn dán value chỗ nào thì chọn chỗ cần dán và click mouse vào icon.

ngo15 · 15/6/07

Cám ơn bạn Thu Nghi. Đúng cái tôi cần. Nhưng tôi vẫn muốn làm thử bài tập đó thì viết macro này như thế nào?

quanghuy_tkt_139 · 13/9/08

Macro copy- paste : chọn trước vùng Paste chứ không phải vùng copy?

ThuNghi đã viết:
Phải ghi macro ngay khi chọn vùng cần copy - Value, Stop
Chớ ghi macro từ lúc dán thì lấy gì mà dán.

hí hi`! bạn ( chị ) Thunghi xinh đẹp ơi, tớ ( em ) cần giúp đỡ :
tớ ( em ) cần một Macro copy nhưng sao cho User được tự chọn vùng Paste bất kỳ chứ không phải Macro tự offset như trên , tức là giống như nút [12] vậy !

thanks nhìu nhé !

bebe08 · 23/7/09

Mình hiểu ý của bạn ngo15 rồi. Mình cũng đang thắc mắc như bạn ấy.
Như bạn Mr Okebab nói thì:
Code:
Sub Macro1()

Range("A1:A6").Copy
Range("D1").PasteSpecial Paste:=xlPasteValues

Application.CutCopyMode = False
End Sub
chỉ copy từ vùng A1:A6, nhưng nếu mình copy vùng bất kì thì sao?
Bây giờ mình muốn paste giá trị vào một vùng khác thì sao?
Code phải sửa như thế nào?
Các bạn trả lời giúp mình nhé!

ndu96081631 · 23/7/09

thuy_IT đã viết:
Mình hiểu ý của bạn ngo15 rồi. Mình cũng đang thắc mắc như bạn ấy.
Như bạn Mr Okebab nói thì:
Code:
Sub Macro1()

Range("A1:A6").Copy
Range("D1").PasteSpecial Paste:=xlPasteValues

Application.CutCopyMode = False
End Sub
chỉ copy từ vùng A1:A6, nhưng nếu mình copy vùng bất kì thì sao?
Bây giờ mình muốn paste giá trị vào một vùng khác thì sao?
Code phải sửa như thế nào?
Các bạn trả lời giúp mình nhé!

Thì dùng InputBox mà chọn vùng tùy ý

PHP:

Sub CopyPaste()
  Dim Des As Range
  With Application.InputBox("Chon vung can copy", Type:=8)
    Set Des = Application.InputBox("Chon vung can paste", Type:=8)
    .Copy: Des.PasteSpecial
  End With
  Application.CutCopyMode = False
End Sub

NguyenNgocSon · 13/4/10

Chào cả nhà. Có ai có thể giúp em ghi Macro để xem lại quá trình tính toán của hàm Solver không? Vì em ghi nó hay báo lỗi và bài toán của em phải chạy Solver nhiều lần với các điều kiện ràng buộc thay đổi nhiều lần ?
Cám ơn sự giúp đỡ
Thân !

sondaubac · 1/8/11

ndu96081631 đã viết:
Thì dùng InputBox mà chọn vùng tùy ý

PHP:

Sub CopyPaste() Dim Des As Range With Application.InputBox("Chon vung can copy", Type:=8) Set Des = Application.InputBox("Chon vung can paste", Type:=8) .Copy: Des.PasteSpecial End With Application.CutCopyMode = False End Sub

Nhưng nó vẫn chưa phải là Copy và Paste special Value (Nếu ô mình cần copy mà là link tính toán thì khi copy sẽ không đúng kết quả).

Gom_mat · 12/6/12

Bạn co câu kết rất chuẩn.thnks

huydo888 · 15/2/13

chào các bạn,

mình có câu hỏi muốn tham khảo

mình muốn copy dữ liệu giữa hai file excel sử dụng Macro.

yêu cầu: khi chạy Macro thì sẽ kiểm tra trên file SOURCE, khi Column 1 có giá trị là A thì copy:

Column 2 -> Colume 5 (của file TARGET)
Column 3 -> Colume 4 (của file TARGET)
Column 4 -> Colume 7 (của file TARGET)
Column 5 -> Colume 2 (của file TARGET)
Column 6 -> Colume 8 (của file TARGET)
Column 7 -> Colume 3 (của file TARGET)
Column 8 -> Colume 6 (của file TARGET)
Column 9-> Colume 9 (của file TARGET)

Các bạn có thể chỉ cho mình cách làm với.

Quang_Hải · 16/2/13

huydo888 đã viết:
chào các bạn,
yêu cầu: khi chạy Macro thì sẽ kiểm tra trên file SOURCE, khi Column 1 có giá trị là A thì copy:
Column 2 -> Colume 5 (của file TARGET)
Column 3 -> Colume 4 (của file TARGET)
Column 4 -> Colume 7 (của file TARGET)
Column 5 -> Colume 2 (của file TARGET)
Column 6 -> Colume 8 (của file TARGET)
Column 7 -> Colume 3 (của file TARGET)
Column 8 -> Colume 6 (của file TARGET)
Column 9-> Colume 9 (của file TARGET)
Các bạn có thể chỉ cho mình cách làm với.

Thử thế này xem sao. Lưu ý là file Source đang mở và dòng tiêu đề phải chuẩn

huydo888 · 16/2/13

quanghai1969 đã viết:
Thử thế này xem sao. Lưu ý là file Source đang mở và dòng tiêu đề phải chuẩn

Cám ơn bạn đã hướng dẫn, nhưng đoạn code sau mình chưa hiểu lắm, bạn có thể giải thích giúp mình không?

.Range(.[C2], .[C65536].End(3)).Resize(, 10).AdvancedFilter 2, [B1:B2], [C4:J4]

Bây giờ mình đã có Format chuẩn của hai file mình muốn copy, bạn có thể xem giúp mình được không? Trong file SOURCE mình đã ghi rõ cột nào mình muốn copy.

*** Chỉ khi nào ô của cột G (file Source) có giá trị là "Thực hiện" thì mới copy giá trị của các ô trong cột J,L,P,R,S,T,W,X sang các cột của file Target.

Cám ơn các bạn!

Ba Tê · 17/2/13

huydo888 đã viết:
Cám ơn bạn đã hướng dẫn, nhưng đoạn code sau mình chưa hiểu lắm, bạn có thể giải thích giúp mình không?

.Range(.[C2], .[C65536].End(3)).Resize(, 10).AdvancedFilter 2, [B1:B2], [C4:J4]

Bây giờ mình đã có Format chuẩn của hai file mình muốn copy, bạn có thể xem giúp mình được không? Trong file SOURCE mình đã ghi rõ cột nào mình muốn copy.

*** Chỉ khi nào ô của cột G (file Source) có giá trị là "Thực hiện" thì mới copy giá trị của các ô trong cột J,L,P,R,S,T,W,X sang các cột của file Target.

Cám ơn các bạn!

Bấm nút GPE trong sheet1, file Target.
2 file Source và Target phải để chung 1 folder.

huydo888 · 18/2/13

Chào bạn Ba Tê,

Mình đã copy vào chung một Folder và chạy Macro (Click nút GPE trong file Target) nhưng nó vẫn chưa copy được, bạn có thể xem lại giúp mình được không?

Cám ơn bạn,

Ba Tê · 18/2/13

huydo888 đã viết:
Chào bạn Ba Tê,

Mình đã copy vào chung một Folder và chạy Macro (Click nút GPE trong file Target) nhưng nó vẫn chưa copy được, bạn có thể xem lại giúp mình được không?

Cám ơn bạn,

File kia phải đúng tên file là SOURCE.xls, tôi thử không bị lỗi, bạn đặt tên khác là "tèo"

huydo888 · 8/3/13

Ba Tê đã viết:
File kia phải đúng tên file là SOURCE.xls, tôi thử không bị lỗi, bạn đặt tên khác là "tèo"

Hôm nay mình mới có thời gian để làm tiếp cái Macro này, cám ơn sự hỗ trợ của bạn Ba Tê rất nhiều.

Bạn cho mình hỏi, mình vẫn chưa chạy được đoạn code này để thực hiện copy dù đã làm đúng theo hướng dẫn của bạn(đã đặt đúng tên là cùng trong một Folder).
Liệu version của Office có ảnh hưởng gì đến vc chạy đoạn code này không bạn? Hiện tại mình đang dùng Office 2003, chưa test thử trên Office 2007 hoặc cao hơn.

Cám ơn bạn Ba Tê rất nhiều!

wayne_quang_88 · 19/7/14

Ai biết sài macro lập cung thức Ẽ mới giúp mình làm file này với

Vui Lòng xem file đính kèm
Cảm ơn

wayne_quang_88 · 21/7/14

Chưa ai giup dc mình file EX này sao??????????????????????.

befaint · 23/7/14

wayne_quang_88 đã viết:
Chưa ai giup dc mình file EX này sao??????????????????????.

Bạn xem file đính kèm đã đúng ý chưa nhé. (mình chỉ làm theo hướng dẫn trong file)
Thân!

thegioiphang77 · 12/3/15

Các bác cho em hỏi sao không thấy có box hay Topic nào hướng dẫn về Word cơ bản nhỉ? Bác nào biết thì dẫn link cho em nhé. Em là thành viên mới có gì sai mong mod thông cảm và chỉ bảo

. Thanks

SA_DQ · 20/3/15

Bài tập cho những thành viên mới bắt đầu

Tôi có 4 cột số liệu (như trong hình)
Các bạn chép giúp tôi lần lượt từng cột số liệu sang cột [G:G]

chuot0106 · 20/3/15

HYen17 đã viết:
Tôi có 4 cột số liệu (như trong hình)
Các bạn chép giúp tôi lần lượt từng cột số liệu sang cột [G:G]

Tôi xin đưa ra 1 cách giải:

Mã:

Public Sub Ghep()
Dim i As Long, rng As Range, kq(), DongCuoi As Long
    Set rng = Sheet1.Range("B2:E" & [B65536].End(xlUp).Row)
For i = 1 To rng.Columns.Count
    DongCuoi = Sheet1.Range("F65536").End(xlUp).Row
    rng(1, i).Resize(rng.Rows.Count, 1).Copy
    Sheet1.Range("F" & DongCuoi + 1).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
Next i
End Sub

SA_DQ · 21/3/15

Rất cảm ơn bạn đã hưởng ứng & tham gia.

(1) Bạn nào có thể dịch từ ngôn ngữ VBA của macro của bạn này sang tiếng Việt được không vậy?

(2) Bạn nào có thể khái quát chu trình của macro của bạn í không vậy các bạn?

(3) Câu lệnh

Mã:

Set rng = Sheet1.Range("B2:E" & [B65536].End(xlUp).Row)

Có thể thay bằng câu lênh nào khác, nhưng vẫn đạt mục đích không, các bạn?

(4) Bạn nào thử sức viết một macro khác không các bạn?

Chúc ngày mới tốt lành!

chuot0106 · 21/3/15

HYen17 đã viết:
..........................................................................
(4) Bạn nào thử sức viết một macro khác không các bạn?

Chúc ngày mới tốt lành!

Em thử dùng mảng xem sao!

Mã:

Public Sub Ghep()
Dim i As Integer, j As Integer, k As Integer
Dim data(), kq()
    data = Sheet1.Range("B2:E" & Sheet1.Range("E65536").End(xlUp).Row)
    ReDim kq(1 To UBound(data, 1) * UBound(data, 2))
    For i = 1 To UBound(data, 2)
        For j = 1 To UBound(data, 1)
            k = k + 1
            kq(k) = data(j, i)
        Next j
    Next i
    [G2].Resize(UBound(data, 1) * UBound(data, 2), 1) = Application.Transpose(kq)
End Sub

Let'GâuGâu · 21/3/15

HYen17 đã viết:
Tôi có 4 cột số liệu (như trong hình)
Các bạn chép giúp tôi lần lượt từng cột số liệu sang cột [G:G]

xin được nộp bài
(ko có số liệu nên chưa test.....hiihihihi)

Mã:

vSub coopy()
Application.ScreenUpdating = False
Dim LastRow, i As Long
LastRow = [b10000].End(3).Row - 1

For i = 1 To 3
[g10000].End(3).Row.Offset(1).Resize(LastRow).Value = [a2].Offset(, i).Resize(LastRow).Value
Next

Application.ScreenUpdating = True

End Sub

chuot0106 · 21/3/15

Let'GâuGâu đã viết:
xin được nộp bài
(ko có số liệu nên chưa test.....hiihihihi)

Mã:

vSub coopy() Application.ScreenUpdating = False Dim LastRow, i As Long LastRow = [b10000].End(3).Row - 1 For i = 1 To 3 [g10000].End(3).Row.Offset(1).Resize(LastRow).Value = [a2].Offset(, i).Resize(LastRow).Value Next Application.ScreenUpdating = True End Sub

Code này báo lỗi tại dòng:

Mã:

[G10000].End(3).Row.Offset(1).Resize(LastRow).Value = [a2].Offset(, i).Resize(LastRow).Value

PhanTuHuong · 21/3/15

Nên hạn chế dùng hàng cuối cùng (65536 của 2003) trong lập trình, vì chỉ vô tình có dữ liệu là sẽ bị sai lệch. Bài toán như ở hình đơn giản nhất là xác định vùng chứa dữ liệu trong 1 cột từ ô đầu tiên và ô cuối cùng (giống chọn Ctr+shìft+ mũi tên chỉ xuống).

Ví dụ: Range(Range("A1"), Range("A1").End(xlDown)) sẽ chọn ô chứa dữ liệu từ A1 đến hàng cuối cùng trên 1 cột.

comet_1701 · 21/3/15

HYen17 đã viết:
(1) Bạn nào có thể dịch từ ngôn ngữ VBA của macro của bạn này sang tiếng Việt được không vậy?

(2) Bạn nào có thể khái quát chu trình của macro của bạn í không vậy các bạn?

(3) Câu lệnh

Mã:

Set rng = Sheet1.Range("B2:E" & [B65536].End(xlUp).Row)

Có thể thay bằng câu lênh nào khác, nhưng vẫn đạt mục đích không, các bạn?

(4) Bạn nào thử sức viết một macro khác không các bạn?

Chúc ngày mới tốt lành!

Em nghĩ ý ba có thể viết thế này

PHP:

Sub Test()
Dim Lastrow As Long, rng As Range
Lastrow = Sheet1.Cells(Sheet1.Columns(2).Rows.Count, 2).End(xlUp).Row
ser rng = Sheet1.Range("B2:E" & Lastrow)
End Sub

phihndhsp · 21/3/15

HYen17 đã viết:
Tôi có 4 cột số liệu (như trong hình)
Các bạn chép giúp tôi lần lượt từng cột số liệu sang cột [G:G]

Rảnh rỗi không có gì làm nên tranh thủ làm bài này chơi

Mã:

Sub ARR_GPE()
Dim rng As Range
Dim arr
Dim I As Long, J As Long
Dim dem As Long
Dim sodong As Long
sodong = Sheet1.Range("A65000").End(xlUp).Row
Set rng = Sheet1.Range("B2:E" & sodong)
ReDim arr(1 To sodong * 4, 1 To 1)
      dem = 1
      For J = 1 To 4
          For I = 1 To sodong - 1
             arr(dem, 1) = rng(I, J)
             dem = dem + 1
        Next I
     Next J
    Sheet1.Range("G2").Resize(dem, 1) = arr
End Sub

chuot0106 · 21/3/15

Mong chủ thớt nhận xét đánh giá ưu nhược điểm của mỗi bài để rút kinh nghiệm.

SA_DQ · 21/3/15

Mong chủ thớt nhận xét đánh giá ưu nhược điểm của mỗi bài để rút kinh nghiệm.

(1) Tạm thời có 1 vài í thế này nha:
1 cách là Copy-Past; 1 cách là xài mảng; Chuyện này khi tăng số dòng có dữ liệu lên hàng vạn thì ta có thể đo thời gian của chương trình cần để vận hành macro.
Chuyện như vậy thiết tưởng mỗi bạn có thể tự xử đi!

(2) Đây cũng là 1 cách để cùng tham khảo:

PHP:

Sub MultipleColumnsIntoColumn()
 Dim Rws As Long, J As Long, W As Long
 Dim Cls As Range, Tmp()
 
 Rws = [B2].CurrentRegion.Rows.Count - 1
 ReDim Arr(1 To 5 * Rws, 1 To 1)
 
 For Each Cls In Range([B2], [B2].End(xlToRight))
    Tmp = Cls.Resize(Rws).Value
    For J = 1 To UBound(Tmp())
        W = W + 1
        Arr(W, 1) = Tmp(J, 1)
    Next J
 Next Cls
 If W Then [G2].Resize(W).Value = Arr()
End Sub

phihndhsp · 29/4/15

Lâu rồi không thấy ai tham gia vào chủ đề này nữa? nên khấy động lại cho các bạn mới tham gia
Bài tập kiểm tra xem trong vùng từ A1:H8 có phần tử yên ngựa hay không? nếu có thì có bao nhiêu phần tử như vậy?
phần tử được gọi là phần tử yên ngựa khi nó lớn nhất trong hàng và nhỏ nhất trong cột.
Nếu được thì giải bằng cách sử dụng các vòng lập để ôn lại kiến thức về VBA

SA_DQ · 29/4/15

Đường hướng giải bài này nên là vầy:

(*) Tạo vòng lặp duyệt theo từng hàng
(*) Ở mỗi hàng tìm giá trị cực đại của hàng đó & ta cho vô biến đã khai báo
(*) Áp dụng fương thức FIND() để tìm ra chỉ số cột của ô chứa trị cực đại trong hàng đang duyệt
(*) Nếu trị cực đại này bằng với trị cực tiểu trong cột là ta đã tìm thấy thì ghi ra giấy!

chuot0106 · 30/4/15

phihndhsp đã viết:
Lâu rồi không thấy ai tham gia vào chủ đề này nữa? nên khấy động lại cho các bạn mới tham gia
Bài tập kiểm tra xem trong vùng từ A1:H8 có phần tử yên ngựa hay không? nếu có thì có bao nhiêu phần tử như vậy?
phần tử được gọi là phần tử yên ngựa khi nó lớn nhất trong hàng và nhỏ nhất trong cột.
Nếu được thì giải bằng cách sử dụng các vòng lập để ôn lại kiến thức về VBA

Gửi đáp án! Code này test với dữ liệu bạn đưa thì không có phần tử nào. Trong File đính kèm của tôi thò có 2 phần tử.
Mong được nhận xét góp ý!

Mã:

Option Explicit

Public Sub yen_ngua1()
Dim i As Long, j As Long, k As Long, vtd As Integer, Arr(), dem As Long
Dim MaxR As Long, MinC As Long, vtc

    Arr = Sheet1.Range("A1").CurrentRegion
For i = 1 To UBound(Arr, 1)
MaxR = Arr(i, 1)
    For j = 1 To UBound(Arr, 2)
        If MaxR < Arr(i, j) Then
            MaxR = Arr(i, j)
            vtc = j
        Else
            MaxR = MaxR
        End If
    Next j
    MinC = Arr(1, vtc)
   For k = 1 To UBound(Arr, 1)
        If MinC > Arr(k, vtc) Then
            MinC = Arr(k, vtc)
         Else
            MinC = MinC
        End If
   Next k
        If MaxR = MinC Then dem = dem + 1
Next i
        MsgBox "Co " & dem & " phan tu yen ngua."
End Sub

phihndhsp · 30/4/15

thử bài này với kỹ thuật lập trình xem sao

Mã:

Function XetCotDong(arr, dong As Integer, cot As Integer, i As Integer, j As Integer) As Byte
 Dim K As Integer
            For K = 1 To dong
                    If (arr(K, j) < arr(i, j)) Then
                        XetCotDong = 0
                        Exit Function
                     End If
            Next
            For K = 1 To cot
                    If (arr(i, K) > arr(i, j)) Then
                        XetCotDong = 0
                         Exit Function
                     End If
           Next
            XetCotDong = 1    
  End Function

Mã:

Function DemYenNgua(arr, dong As Integer, cot As Integer) As Byte
    Dim dem As Integer
    Dim i As Integer
    Dim j As Integer
    dem = 0
    For i = 1 To dong
        For j = 1 To cot
           If (XetCotDong(arr, dong, cot, i, j) = 1) Then
            dem = dem + 1
           End If
        Next
     Next
 DemYenNgua = dem
 End Function

Mã:

Sub GPE()
Dim arr()
     arr = [COLOR=#ff0000][B]Range("A1:H8").Value[/B][/COLOR]
     MsgBox DemYenNgua(arr,[B] [COLOR=#ff0000]8[/COLOR][/B], [COLOR=#ff0000][B]8[/B][/COLOR])
End Sub

chỗ màu đỏ đó có thể thay thế

chuot0106 · 30/4/15

phihndhsp đã viết:

thử bài này với kỹ thuật lập trình xem sao

Mã:

Function XetCotDong(arr, dong As Integer, cot As Integer, i As Integer, j As Integer) As Byte
 Dim K As Integer
            For K = 1 To dong
                    If (arr(K, j) < arr(i, j)) Then
                        XetCotDong = 0
                        Exit Function
                     End If
            Next
            For K = 1 To cot
                    If (arr(i, K) > arr(i, j)) Then
                        XetCotDong = 0
                         Exit Function
                     End If
           Next
            XetCotDong = 1    
  End Function

Mã:

Function DemYenNgua(arr, dong As Integer, cot As Integer) As Byte
    Dim dem As Integer
    Dim i As Integer
    Dim j As Integer
    dem = 0
    For i = 1 To dong
        For j = 1 To cot
           If (XetCotDong(arr, dong, cot, i, j) = 1) Then
            dem = dem + 1
           End If
        Next
     Next
 DemYenNgua = dem
 End Function

Mã:

Sub GPE()
Dim arr()
     arr = [COLOR=#ff0000][B]Range("A1:H8").Value[/B][/COLOR]
     MsgBox DemYenNgua(arr,[B] [COLOR=#ff0000]8[/COLOR][/B], [COLOR=#ff0000][B]8[/B][/COLOR])
End Sub

chỗ màu đỏ đó có thể thay thế

Làm gì mà tác giả đưa đáp án sớm vậy. Theo tôi bài tập này để luyện kĩ năng dùng vòng lặp for rất hay.
P/s: bài này có nhiều cách làm, các thành viên mới học vba nên thử xem sao?

phihndhsp · 30/4/15

Bài tập đến số lượng số nguyên tố:
đếm xem trong vùng A1:H8 có bao nhiêu số nguyên tố, và tìm xem số nguyên tố nào là số nguyên tố lớn nhất

ChanhTQ@ · 30/4/15

Gửi đáp án! Code này test với dữ liệu bạn đưa thì không có phần tử nào. Trong File đính kèm của tôi thò có 2 phần tử.
Mong được nhận xét góp ý!

Ở những trường hợp đặc biệt thì bạn cần sửa lại macro rồi!
(1) Như hình
(2) Nếu trong file của bạn, ta sửa lại tại [H4] có trị là 9 thì đâu là đáp án đây?

chuot0106 · 30/4/15

phihndhsp đã viết:
Bài tập đến số lượng số nguyên tố:
đếm xem trong vùng A1:H8 có bao nhiêu số nguyên tố, và tìm xem số nguyên tố nào là số nguyên tố lớn nhất

Thử code này xem sao!

Mã:

Public Sub SNT()
Dim i As Long, j As Long, k As Long, dem_uoc As Byte, dem_s As Byte
Dim Rng As Range
Set Rng = Sheet1.Range("A1:H8")
For i = 1 To Rng.Rows.Count
    For j = 1 To Rng.Columns.Count
        dem_uoc = 0
        For k = 1 To Val(Rng(i, j))
            If Val(Rng(i, j)) Mod k = 0 Then dem_uoc = dem_uoc + 1
        Next k
        If dem_uoc = 2 Then dem_s = dem_s + 1
    Next j
Next i
    MsgBox dem_s
End Sub

Quang_Hải · 30/4/15

chuot0106 đã viết:

Thử code này xem sao!

Mã:

Public Sub SNT()
Dim i As Long, j As Long, k As Long, dem_uoc As Byte, dem_s As Byte
Dim Rng As Range
Set Rng = Sheet1.Range("A1:H8")
For i = 1 To Rng.Rows.Count
    For j = 1 To Rng.Columns.Count
        dem_uoc = 0
        For k = 1 To Val(Rng(i, j))
            If Val(Rng(i, j)) Mod k = 0 Then dem_uoc = dem_uoc + 1
        Next k
        If dem_uoc = 2 Then dem_s = dem_s + 1
    Next j
Next i
    MsgBox dem_s
End Sub

Bài này hình như chỉ cần 1 vòng For Each và 1 If để đếm số nguyên tố. Nếu lấy SNT lớn nhất thì thêm 1 If nữa là được. Lấy phần tử trong mảng chia cho 6 là có thể kiểm tra xem có phải là SNT hay không.
Cũng có thể mình sai vì chưa code ra cụ thể mà chỉ suy luận thôi.

chuot0106 · 30/4/15

Quên chưa tìm số nguyên tố lớn nhất:

Mã:

Public Sub SNT2()
Dim i As Long, j As Long, k As Long, dem_uoc As Byte, dem_s As Byte, tmp(1 To 1000), snt_max As Long, m As Integer
Dim Rng As Range
Set Rng = Sheet1.Range("A1:H8")

For i = 1 To Rng.Rows.Count
    For j = 1 To Rng.Columns.Count
        dem_uoc = 0
        For k = 2 To Val(Rng(i, j))
            If Val(Rng(i, j)) Mod k = 0 Then dem_uoc = dem_uoc + 1
        Next k
        If dem_uoc = 1 Then
            dem_s = dem_s + 1
            tmp(dem_s) = Rng(i, j)
        End If
    Next j
Next i
    For m = 1 To UBound(tmp)
        If snt_max < tmp(m) Then snt_max = tmp(m)
        Next m
            MsgBox "Co " & dem_s & " so nguyen to." & Chr(13) & "So nguyen to lon nhat la: " & snt_max
End Sub

chuot0106 · 30/4/15

Rút ngắn code đi chút:

Mã:

Option Explicit

Public Sub SNT3()
Dim i As Long, dem_uoc As Byte, dem_s As Byte, tmp, snt_max As Long
Dim Rng As Range, cll As Range
Set Rng = Sheet1.Range("A1:H8")

For Each cll In Rng
    dem_uoc = 0
    For i = 1 To cll
        If cll Mod i = 0 Then dem_uoc = dem_uoc + 1
    Next i
        If dem_uoc = 2 Then
            dem_s = dem_s + 1
            If tmp < cll Then tmp = cll
        End If
Next cll
            MsgBox "Co " & dem_s & " so nguyen to." & Chr(13) & "So nguyen to lon nhat la: " & tmp
End Sub

chuot0106 · 30/4/15

Tôi có 1 bài tập đơn giản giành cho các bạn mới học VBA.
--------------------------------------------------------------------------------
Tìm tất cả các số chính phương trong vùng "A1:I21" và đưa kết quả ra các cell trên bảng tính
----------------------------------------
Số chính phương hay còn gọi là số hình vuông là số tự nhiên có căn bậc 2 là một số tự nhiên, hay nói cách khác, số chính phương là bình phương (lũy thừa bậc 2) của một số tự nhiên khác.

Ví dụ:

4 = 2²
9 = 3²

Quang_Hải · 30/4/15

Mình không rành lắm mấy vụ toán học nhưng nếu code cho vui thì code thế này
Code mình viết đếm ra tới 21 SNT. Quái thiệt.

PHP:

Sub abc()
Dim arr(), item, dem, sntMax
arr = [A1:H8].Value
For Each item In arr
   If item Mod 6 = 1 Or item Mod 6 = 5 Or item = 2 Then
      dem = dem + 1
      If item > sntMax Then sntMax = item
   End If
Next
MsgBox "Có " & dem & "SNT" & vbLf & "SNT lon nhat: " & sntMax
End Sub

ptm0412 · 30/4/15

chuot0106 đã viết:
Rút ngắn code đi chút:

Mã:

For Each cll In Rng dem_uoc = 0 [COLOR=#ff0000] For i = 1 To cll[/COLOR] If cll Mod i = 0 Then dem_uoc = dem_uoc + 1 Next i

Để xác định số nguyên tố bằng vòng lặp thì không cần lặp đến tận cùng như thế.

ptm0412 · 30/4/15

quanghai1969 đã viết:
Mình không rành lắm mấy vụ toán học nhưng nếu code cho vui thì code thế này
Code mình viết đếm ra tới 21 SNT. Quái thiệt.

PHP:

If item Mod 6 = 1 Or item Mod 6 = 5 Or item = 2 Then dem = dem + 1 End If

Xét điều kiện này thì 3 không phải sô nguyên tố. Trong khi đó 25, 35 lại là số nguyên tố

phihndhsp · 30/4/15

quanghai1969 đã viết:
Mình không rành lắm mấy vụ toán học nhưng nếu code cho vui thì code thế này
Code mình viết đếm ra tới 21 SNT. Quái thiệt.

PHP:

Sub abc() Dim arr(), item, dem, sntMax arr = [A1:H8].Value For Each item In arr If item Mod 6 = 1 Or item Mod 6 = 5 Or item = 2 Then dem = dem + 1 If item > sntMax Then sntMax = item End If Next MsgBox "Có " & dem & "SNT" & vbLf & "SNT lon nhat: " & sntMax End Sub

thử thuật toán này với số 49 xem sao còn số 35 nữa và một số bội của 7

chuot0106 · 30/4/15

ptm0412 đã viết:
Để xác định số nguyên tố bằng vòng lặp thì không cần lặp đến tận cùng như thế.

Chính xác là vậy. Cái này chỉ cần xét đến phần nguyên của cll/2 thôi ạ. Em cảm ơn thầy!

Quang_Hải · 30/4/15

Đã nói rồi, bài này mình chẳng có cơ bản nên code chủ yếu là hưởng ứng các ngày lễ lớn trong năm thôi.

phihndhsp · 30/4/15

chuot0106 đã viết:
Chính xác là vậy. Cái này chỉ cần xét đến phần nguyên của cll/2 thôi ạ. Em cảm ơn thầy!

Xét đến căn bậc 2 là được rồi

chuot0106 · 30/4/15

phihndhsp đã viết:
Xét đến căn bậc 2 là được rồi

Nếu áp dụng thuật toán của tôi thì phải đến phần nguyên của cll/2. Ví dụ với số 81 mà xét i=1 đến 9 thì tèo luôn.

phihndhsp · 30/4/15

chuot0106 đã viết:
Nếu áp dụng thuật toán của tôi thì phải đến phần nguyên của cll/2. Ví dụ với số 81 mà xét i=1 đến 9 thì tèo luôn.

Suy nghĩ lại thuật toán đi nha, tôi nói chạy đến căn bậc 2 là tối ưu nhất

ptm0412 · 30/4/15

chuot0106 đã viết:
Nếu áp dụng thuật toán của tôi thì phải đến phần nguyên của cll/2. Ví dụ với số 81 mà xét i=1 đến 9 thì tèo luôn.

81 thì lại chỉ cần xét đến 3 là ngưng rồi. Còn Phi nói chỉ xét đến căn bậc 2 là đúng. Thêm 1 ý là xét tối đa đến căn bậc 2.

phihndhsp · 30/4/15

Mã:

Function KTNT(n As Long) As Boolean
    ' Chi xet cac so duong thoi
 Dim Tam As Boolean
 Dim i As Long
    If (n = 1) Then
         KTNT = False
        Exit Function
    End If
  
    If (n > 1 And n < 4) Then
        KTNT = True
        Exit Function
    End If
    Tam = True
    For i = 2 To Sqr(n)
        If (n Mod i = 0) Then
              Tam = False
              Exit For
         End If
     Next
    KTNT = Tam
End Function

Mã:

Sub GPE()
Dim Arr()
Dim Max_NT As Long
Dim DS_NT As String
Dim Tam As Long
       
       DS_NT = "   "
       Arr = Range("A1:H8")
       Max_NT = 0
       For i = 1 To 8
        For j = 1 To 8
            Tam = Arr(i, j)
            If (KTNT(Tam) = True) Then
                DS_NT = DS_NT & Tam & "   "
                If (Tam > Max_NT) Then
                    Max_NT = Tam
                End If
            End If
         Next j
    Next i
   If (Max_NT > 0) Then
    MsgBox "So nguyen to lon nhat" & Max_NT
   Else
    MsgBox " khong co So nguyen to lon nhat"
   End If
  MsgBox DS_NT
    
End Sub

Function KTNT là kiểm tra tính nguyên tố của một số
Sub GPE là duyệt qua các phần tử của mảng để biết số nào là số nguyên tố và tìm xem số nguyên tố lớn nhất

Bài tập
có thể viết Function KTNT theo hướng đệ quy?

chuot0106 · 30/4/15

phihndhsp đã viết:
-------------------------------------------------------------------------------
Function KTNT là kiểm tra tính nguyên tố của một số
Sub GPE là duyệt qua các phần tử của mảng để biết số nào là số nguyên tố và tìm xem số nguyên tố lớn nhất

Bài tập
có thể viết Function KTNT theo hướng đệ quy?

Thuật toán thì có nhiều, nhưng chọn thuật toán nào tối ưu nhất mới là vấn đề! !$@!!

--------------------------------------------------------------------------------------------------------------------------------
Mấy thuật toán này ngày xưa học pascal thì cũng biết sơ qua vì ngày đó học tin có biết để làm gì đâu nên giờ quên sạch. Giờ tự ngồi nghĩ hướng giải quyết để nâng cao khả năng tư duy +-+-+-+

phihndhsp · 30/4/15

có thể viết Function KTNT theo hướng đệ quy?

Mời các thành viên tham gia viết code để học hỏi thêm và ôn luyện cách viết code, "Nhất là các bạn nào mới tiếp xúc VBA xem như đây là các vấn đề mình cần giải quyết"
Yêu cầu có thể viết một Function kiểm tra tính nguyên tố của 1 số bằng phương pháp đệ quy?

chuot0106 · 30/4/15

phihndhsp đã viết:
Mời các thành viên tham gia viết code để học hỏi thêm và ôn luyện cách viết code, "Nhất là các bạn nào mới tiếp xúc VBA xem như đây là các vấn đề mình cần giải quyết"
Yêu cầu có thể viết một Function kiểm tra tính nguyên tố của 1 số bằng phương pháp đệ quy?

Không rõ đây là câu hỏi hay là đề bài vậy bạn?
------------------------------------------------------------
Với bài toán tính giai thừa thì hàm đệ quy viết đơn giản thế này, nhưng với bài toán kiểm tra số nguyên tố thì không biết có viết được bằng đệ quy không nữa. Tôi nghĩ là không viết được.

Mã:

Public Function gt(n) As Double
Dim i As Long
If n = 0 Then
    gt = 1
Else
    gt = n * gt(n - 1)
End If
End Function

phihndhsp · 30/4/15

chuot0106 đã viết:
Không rõ đây là câu hỏi hay là đề bài vậy bạn?

Đây là đề bài. Bạn có thể tham gia code bằng đệ quy

chuot0106 · 30/4/15

phihndhsp đã viết:
Đây là đề bài. Bạn có thể tham gia code bằng đệ quy

Tôi cũng loay hoay 1 lúc nhưng chưa nghĩ ra được thuật toán. Mong được học hỏi!

phihndhsp · 30/4/15

chuot0106 đã viết:
Tôi cũng loay hoay 1 lúc nhưng chưa nghĩ ra được thuật toán. Mong được học hỏi!

Cứ từ từ, tôi thấy tất cả các code bạn viết. Bạn ít có vận dụng function để chia nhỏ vấn đề ra để quản lý. Mà cái đó cực kỳ linh hoạt trong việc code kiết. Bài giai thừa của bạn tất cả là kiểu long sao giá trị trả về là double?

chuot0106 · 30/4/15

phihndhsp đã viết:
Cứ từ từ, tôi thấy tất cả các code bạn viết. Bạn ít có vận dụng function để chia nhỏ vấn đề ra để quản lý. Mà cái đó cực kỳ linh hoạt trong việc code kiết. Bài giai thừa của bạn tất cả là kiểu long sao giá trị trả về là double?

Thực ra kĩ thuật lập trình và kiến thức cơ bản là những cái tôi rất yếu(Tôi không được học cơ bản), mong được học hỏi nhiều từ bạn và các thành viên khác.

phihndhsp · 30/4/15

Mời các thành viên mới đang học VBA tham gia đề tài cho sum tụ. Cùng nhau tiến bộ

phihndhsp · 30/4/15

phihndhsp đã viết:
Mời các thành viên tham gia viết code để học hỏi thêm và ôn luyện cách viết code, "Nhất là các bạn nào mới tiếp xúc VBA xem như đây là các vấn đề mình cần giải quyết"
Yêu cầu có thể viết một Function kiểm tra tính nguyên tố của 1 số bằng phương pháp đệ quy?

code đệ quy kiểm tra tính nguyên tố của một số

Mã:

Function KTNT(n As Long, dau As Long, cuoi As Long) As Boolean
    If (n = 1) Then
        KTNT = False
        Exit Function
     End If
     
    If (cuoi < dau) Then
        KTNT = True
        Exit Function
     End If
     If (n Mod dau = 0) Then
        KTNT = False
        Exit Function
     End If
     KTNT = KTNT(n, dau + 1, cuoi)
End Function

code chính lấy ra những số đúng là số nguyên tố

Mã:

Sub GPE()
Dim Arr()
Dim Max_NT As Long
Dim DS_NT As String
Dim Tam As Long
       
       DS_NT = "   "
       Arr = Range("A1:H8")
       Max_NT = 0
       For i = 1 To 8
        For j = 1 To 8
            Tam = Arr(i, j)
            If (KTNT(Tam, 2, Sqr(Tam)) = True) Then
                DS_NT = DS_NT & Tam & "   "
                If (Tam > Max_NT) Then
                    Max_NT = Tam
                End If
            End If
         Next j
    Next i
   If (Max_NT > 0) Then
    MsgBox "So nguyen to lon nhat" & Max_NT
   Else
    MsgBox " khong co So nguyen to lon nhat"
   End If
  MsgBox DS_NT
    
End Sub

Hau151978 · 30/4/15

phihndhsp đã viết:
Mời các thành viên mới đang học VBA tham gia đề tài cho sum tụ. Cùng nhau tiến bộ

Cách của mình chắc chỉ đệ quy cho vui thôi, dùng vòng lặp hiệu quả hơn nhiều.

Mã:

Function NT(ByVal p&, ByVal q&) As Boolean
    If q < 2 Then
        NT = True
        Exit Function
    End If
    If p Mod q = 0 Then NT = False Else NT = NT(p, q - 2)
End Function
Function KTNT(ByVal p&) As Boolean
    If p < 2 Then
        KTNT = False
    ElseIf p < 4 Then
        KTNT = True
    ElseIf p Mod 2 = 0 Then
        KTNT = False
    Else
        KTNT = NT(p, Int(Sqr(p)))
    End If
End Function

chuot0106 · 30/4/15

Hau151978 đã viết:
Cách của mình chắc chỉ đệ quy cho vui thôi, dùng vòng lặp hiệu quả hơn nhiều.

Mã:

Function NT(ByVal p&, ByVal q&) As Boolean If q < 2 Then NT = True Exit Function End If If p Mod q = 0 Then NT = False Else NT = NT(p, q - 2) End Function Function KTNT(ByVal p&) As Boolean If p < 2 Then KTNT = False ElseIf p < 4 Then KTNT = True ElseIf p Mod 2 = 0 Then KTNT = False Else KTNT = NT(p, Int(Sqr(p))) End If End Function

Thực sự là viết đệ quy là để học thuật toán này thôi chứ bài này dùng đệ quy đúng là phức tạp. Với bài toán "Tháp cổ Hà Nội" thì dùng đệ quy thì hợp lí hơn. Bài này vòng lập dễ hiểu hơn!

phihndhsp · 1/5/15

Hau151978 đã viết:
Cách của mình chắc chỉ đệ quy cho vui thôi, dùng vòng lặp hiệu quả hơn nhiều.

Mã:

Function NT(ByVal p&, ByVal q&) As Boolean If q < 2 Then NT = True Exit Function End If If p Mod q = 0 Then NT = False Else NT = NT(p, q - 2) End Function Function KTNT(ByVal p&) As Boolean If p < 2 Then KTNT = False ElseIf p < 4 Then KTNT = True ElseIf p Mod 2 = 0 Then KTNT = False Else KTNT = NT(p, Int(Sqr(p))) End If End Function

Thuật toán của anh hay đấy chứ (Áp dụng sặc mùi toán học luôn hihi). sao lại nghĩ là chơi vui, đúng là dùng vòng lặp dễ còn hiệu quả hơn thì hên suôi( tùy vào trường hợp nào mà ta áp dụng cái nào cho hiệu quả). Ở đây là mục bài tập nên mình chỉ bàn đến các giải thuật để giải quyết vấn đề sau đó cảm thấy cái nào hay thì mình học hỏi vậy thôi

phihndhsp · 1/5/15

Bài tiếp theo dễ hơn bài trước nhiều, các thành viên mới nên tham gia để học hỏi tư duy:
Yêu cầu chuyển 1 số từ hệ thập phân sang hệ nhị phân? (nếu có thể thì làm bằng vòng lặp và đệ quy luôn)
ví dụ N= 15 thì kết quả mong muốn là 1111
ví dụ N= 10 thì kết quả mong muốn là 1010
chúc các bạn ngày mới vui vẻ

Hau151978 · 1/5/15

Bài này dùng đệ quy cho đỡ phải viết nhiều. Mình online bằng điện thoại, test sau.

Mã:

Function DecimalToBinary(Byval n&) As String
   If n<2 Then
       DecimalToBinary=CStr(n)
    Else
        DecimalToBinary=DecimalToBinary(Int(n/2)) & (n Mod 2)
   End If
End Function

phihndhsp · 1/5/15

Hau151978 đã viết:
Bài này dùng đệ quy cho đỡ phải viết nhiều. Mình online bằng điện thoại, test sau.

Mã:

Function DecimalToBinary(Byval n&) As String If n<2 Then DecimalToBinary=CStr(n) Else DecimalToBinary=DecimalToBinary(Int(n/2)) & (n Mod 2) End If End Function

của tôi thì như vậy

Mã:

Function NhiPhan(n, ByRef Tam As String) As String
        If (n > 0) Then
          NhiPhan = NhiPhan(Int(n / 2), Tam)
          Tam = Tam & n Mod 2
       End If
    NhiPhan = Tam
End Function

các thành viên khác có thể tham gia viết code bằng vòng lặp hoặc đệ quy hoặc thấy thuật toán nào hay mình tham gia viết để học hỏi kinh nghiệm

Hau151978 · 1/5/15

Hau151978 đã viết:
Cách của mình chắc chỉ đệ quy cho vui thôi, dùng vòng lặp hiệu quả hơn nhiều.

Mã:

Function NT(ByVal p&, ByVal q&) As Boolean If q < 2 Then NT = True Exit Function End If If p Mod q = 0 Then NT = False Else NT = NT(p, q - 2) End Function Function KTNT(ByVal p&) As Boolean If p < 2 Then KTNT = False ElseIf p < 4 Then KTNT = True ElseIf p Mod 2 = 0 Then KTNT = False Else KTNT = NT(p, Int(Sqr(p))) End If End Function

Bài này mình cần sửa lại. Do hàm NT chỉ cần xét các tham số q lẻ nên lệnh cuối của hàm KTNT cần sửa thành
KTNT = NT(p, Int(Sqr(p)) - 1 + (Int(Sqr(p)) Mod 2))

Mã:

Function NT(ByVal p&, ByVal q&) As Boolean
    If q < 2 Then
        NT = True
        Exit Function
    End If
    If p Mod q = 0 Then NT = False Else NT = NT(p, q - 2)
End Function
Function KTNT(ByVal p&) As Boolean
    If p < 2 Then
        KTNT = False
    ElseIf p < 4 Then
        KTNT = True
    ElseIf p Mod 2 = 0 Then
        KTNT = False
    Else
        KTNT = NT(p, Int(Sqr(p)) - 1 + (Int(Sqr(p)) Mod 2))
    End If
End Function

chuot0106 · 1/5/15

phihndhsp đã viết:
Bài tiếp theo dễ hơn bài trước nhiều, các thành viên mới nên tham gia để học hỏi tư duy:
Yêu cầu chuyển 1 số từ hệ thập phân sang hệ nhị phân? (nếu có thể thì làm bằng vòng lặp và đệ quy luôn)
ví dụ N= 15 thì kết quả mong muốn là 1111
ví dụ N= 10 thì kết quả mong muốn là 1010
chúc các bạn ngày mới vui vẻ

Thử code này xem sao!

Mã:

Public Function SoNhiPhan(n) As String
Dim a As Integer, b As Integer, Tmp As String
    Tmp = ""
Do While n >= 1
    a = n Mod 2: b = Int(n / 2)
    Tmp = a & Tmp: n = b
Loop
    SoNhiPhan = Tmp
End Function

phihndhsp · 1/5/15

chuot0106 đã viết:
Thử code này xem sao!

Mã:

Public Function SoNhiPhan(n) As String Dim a As Integer, b As Integer, Tmp As String Tmp = "" Do While n >= 1 a = n Mod 2: b = Int(n / 2) Tmp = a & Tmp: n = b Loop SoNhiPhan = Tmp End Function

tôi rút ngắn lại dùm bạn một tí xíu

Mã:

Public Function SoNhiPhan(n) As String
Dim Tmp As String
    Tmp = ""
Do While n > 0
         Tmp = n Mod 2 & Tmp
          n = Int(n / 2)
Loop
    SoNhiPhan = Tmp
End Function

Những bạn trên diễn đàn muốn học VBA mà không chịu tham gia giải các bài tập để rèn luyện tư duy cho sum tụ để các thành viên đưa ra các chủ đề còn hứng thú nghĩ ra nhiều bài tập. Chứ vắng hoe thành viên tham gia thì nản lắm

chuot0106 · 1/5/15

phihndhsp đã viết:
tôi rút ngắn lại dùm bạn một tí xíu

Mã:

Public Function SoNhiPhan(n) As String Dim Tmp As String Tmp = "" Do While n > 0 Tmp = n Mod 2 & Tmp n = Int(n / 2) Loop SoNhiPhan = Tmp End Function

Những bạn trên diễn đàn muốn học VBA mà không chịu tham gia giải các bài tập để rèn luyện tư duy cho sum tụ để các thành viên đưa ra các chủ đề còn hứng thú nghĩ ra nhiều bài tập. Chứ vắng hoe thành viên tham gia thì nản lắm

Chắc tại ngày lễ mà anh Phi.

chuot0106 · 1/5/15

Xin phép ra đề dựa vào bài tập trước của anh Phi
---------------------------------------------------------------------
Đề bài: Chuyển các số nhị phân sang số thập phân.
----------------------------------------------------------------
Đáp án đây:
( Chỉ xem khi bạn viết xong code)

Mã:

[COLOR=#f0ffff]Public Function ConvertSNPtoSTP(snp) As Integer
Dim i As Long, So As Long
For i = 1 To Len(snp)
    So = So + Val(Mid(snp, i, 1)) * 2 ^ (Len(snp) - i)
Next i
    ConvertSNPtoSTP = So[/COLOR]
[COLOR=#f0f8ff]End Function[/COLOR]

ndu96081631 · 1/5/15

Liên quan đến số nhị phân, tôi thấy các bạn quá chủ quan khi không nghĩ đến trường hợp SỐ ÂM
Có ai biết trong Excel, các con số -1, -2, -3... (hệ thập phân) được biểu diễn sang nhị phân như thế nào không?
Tôi dùng hàm DEC2BIN trên Excel và có kết quả như sau:
- DEC2BIN(-1) cho kết quả 1111111111
- DEC2BIN(-2) cho kết quả 1111111110
- DEC2BIN(-3) cho kết quả 1111111101
và hàm DEC2BIN giới hạn tối đa đến số 511 (công thức =DEC2BIN(512) báo lỗi). Thêm nữa công thức =DEC2BIN(511) cho kết quả 111111111 là 9 con số 1, trong khi DEC2BIN(số âm) cho kết quả 1 chuỗi 10 ký tự
Cảm giác dường như anh Bill dùng con số 1 đầu tiên bên trái để ký hiệu số âm hay sao ấy. Mà nghĩ lại thấy cũng hợp lý: Máy tính nó chỉ biết 0 và 1 chứ làm gì biết dấu - của số âm. Vậy cũng phải có cách chuyển đổi gì đó chứ nhỉ? (quy ước)

phihndhsp · 1/5/15

ndu96081631 đã viết:
Liên quan đến số nhị phân, tôi thấy các bạn quá chủ quan khi không nghĩ đến trường hợp SỐ ÂM
Có ai biết trong Excel, các con số -1, -2, -3... (hệ thập phân) được biểu diễn sang nhị phân như thế nào không?

Cái này liên quan tới bù 1 bù 2 với lại trên diễn đàn cũng ít người biết đến biểu diễn số nhị phân nhiều, nên các bài tập về nhị phân thì mình hạn chế chỉ biểu diễn số dương thôi anh.

Ví dụ 5 = 00000101
bù 1 của -5 ( bù 1 là đảo các số ngược lại với sô dương)
-5= 11111010
Bù 2 ( Bù 2 là đảo các số ngược lại với số dương sau đó +1
-5 = 11111011

phihndhsp · 1/5/15

Trong toán học bít dấu người ta không thể hiện( vì nó ngầm hiểu bít đầu tiên là số 1 vì là số âm) trong biểu diễn anh

phihndhsp · 1/5/15

mà nói tới nhị phân là nói tới chuyện dài tập. Cái này nếu anh muốn nghiên cứu thì tìm sách cấu trúc máy tính thì sẽ rõ hơn, sách đó nói rõ ràng các phép tính cộng trừ nhân chia số mũ ... trong hệ nhị phân(thực sự trong hệ nhị phân chỉ có phép cộng mà thôi những cái khác là biến thể của phép cộng)

ndu96081631 · 1/5/15

phihndhsp đã viết:
Trong toán học bít dấu người ta không thể hiện( vì nó ngầm hiểu bít đầu tiên là số 1 vì là số âm) trong biểu diễn anh

Hình như là trong máy tính chứ nhỉ?

chuot0106 · 1/5/15

Tôi xin có ý kiến riêng 1 chút. Theo tôi bắt đầu từ các bài tập mới bây giờ nên đánh số thứ tự của bài tập để các thành viên dễ tham gia giải mà người đưa bài tập cũng dễ quản lí. Nội dung bài tập nên đưa vào tag code cho dễ nhìn, dễ đọc. Chủ để khá dài rồi. Bài tập và các nội dung thì cứ đan xen nhau.

Hau151978 · 1/5/15

phihndhsp đã viết:
Trong toán học bít dấu người ta không thể hiện( vì nó ngầm hiểu bít đầu tiên là số 1 vì là số âm) trong biểu diễn anh

VBA lưu số âm theo phương pháp bù 2. Chỉ có kiểu Interger (16 bit) và Long (32 bit) mới có số âm còn kiểu Byte (8 bit) không có.
Bit dấu vẫn tồn tại. Đối với số interger số dương lớn nhất là 0111 1111 1111 1111 =2^15-1 = 32767. Số âm nhỏ nhất là a=1000 0000 0000 0000, a-1=0111 1111 1111 1111, sau khi đảo các bit được 1000 0000 0000 0000 = 2^15 = 32768 nên số âm nhỏ nhất là -32768.
Tương tự số Long từ -2^31 đến 2^31-1.

Quang_Hải · 1/5/15

Đối với thành viên mới học VBA như mình thì chỉ quan tâm đến cái gì đó cụ thể, ứng dụng được cho công việc. Chứ mấy dạng thuật toán cao cấp như đệ quy, nhị phân hay thập phân gì gì đó thì mình chẳng dám đụng vào làm gì chỉ mất sức. Cứ thử kéo dài dạng bài tập thế này thì cứ chờ xem coi có thành viên mới nào dám tham gia hay không nhé.
Đã là bài tập thì phải mang tính vừa sức, hoặc chỉ ráng thêm tí là tới. Đằng này xa tít mù khơi thì ráng sao nổi. Thử hỏi trên GPE được mấy người có học bài bản về lập trình. Dân đi làm thì cứ là lọc dữ liệu, thống kê dữ liệu....
Đối với những người khá hơn chút mà có tí máu me với code thì mới thức đêm thức hôm để luyện. Mà luyện cũng chỉ cho vui chứ sau 1 thời gian không xài thì cũng trả lại cho bác Bill sạch.

Ngắn gọn lại là: muốn có nhiều thành viên mới tham gia vào cho hào hứng chủ đề thì chúng ta nên xem lại các bài tập đã, đang và sẽ post lên diễn đàn. Còn những dạng kiến thức trung, cao cấp thì nên mở riêng chủ đề riêng. Chẳng hạn nói về thuật toán đệ quy, theo mình thì đó là kiến thức lập trình cao cấp và chắc ít người am tường.

Vài lời chia sẻ, nếu có gì mạo phạm mong mọi người lượng thứ và không ném đá túi bụi.

phihndhsp · 1/5/15

Anh Hải nói chí lý, muốn khởi động topic này cho sum tụ thì cần lắm những vấn đề thực tế mà các thành viên gạo cội đã gặp phải để cho các thành viên mới học hỏi thêm.

Hau151978 · 1/5/15

Lập trình bằng VB thiên về lập trình ứng dụng nhiều hơn, vấn đề thuật toán thường là thứ yếu. Hồi học THPT về tin học có lẽ học thuật toán là thứ mình ghét nhất. Sau này khi VB ra đời khiến cho "ai cũng có thể trở thành lập trình viên", mọi thứ đã được VB làm hết.
Trở lại bài #86 của bạn chuot0106, code này đúng, ngắn gọn nhưng tốc độ chậm do mỗi lần tính 2, 2^2, 2^3... các số này đều tính lại từ đầu dẫn đến thừa nhiều phép nhân. Mình cải tiến code đó như sau:

Mã:

Function Binary2Decimal(ByVal b) As Long
    Dim tmp, s, i&, n&
    n = Len(b)
    tmp = 1
    For i = 1 To n
       s = Mid(b, n - i + 1, 1)
       Binary2Decimal = Binary2Decimal + IIf(s = 0, 0, tmp)
       tmp = tmp * 2
    Next
End Function

Trong code này, biến tmp sẽ lưu các giá trị lũy thừa của 2, biến n lưu giá trị LEN(b) mà không dùng trực tiếp trong vòng lặp để tránh LEN(b) phải tính lại nhiều lần.

ndu96081631 · 1/5/15

quanghai1969 đã viết:
Đối với thành viên mới học VBA như mình thì chỉ quan tâm đến cái gì đó cụ thể, ứng dụng được cho công việc. Chứ mấy dạng thuật toán cao cấp như đệ quy, nhị phân hay thập phân gì gì đó thì mình chẳng dám đụng vào làm gì chỉ mất sức. Cứ thử kéo dài dạng bài tập thế này thì cứ chờ xem coi có thành viên mới nào dám tham gia hay không nhé.
Đã là bài tập thì phải mang tính vừa sức, hoặc chỉ ráng thêm tí là tới. Đằng này xa tít mù khơi thì ráng sao nổi. Thử hỏi trên GPE được mấy người có học bài bản về lập trình. Dân đi làm thì cứ là lọc dữ liệu, thống kê dữ liệu....
Đối với những người khá hơn chút mà có tí máu me với code thì mới thức đêm thức hôm để luyện. Mà luyện cũng chỉ cho vui chứ sau 1 thời gian không xài thì cũng trả lại cho bác Bill sạch.

Ngắn gọn lại là: muốn có nhiều thành viên mới tham gia vào cho hào hứng chủ đề thì chúng ta nên xem lại các bài tập đã, đang và sẽ post lên diễn đàn. Còn những dạng kiến thức trung, cao cấp thì nên mở riêng chủ đề riêng. Chẳng hạn nói về thuật toán đệ quy, theo mình thì đó là kiến thức lập trình cao cấp và chắc ít người am tường.

Vài lời chia sẻ, nếu có gì mạo phạm mong mọi người lượng thứ và không ném đá túi bụi.

Đồng ý!
Và thêm nữa: Dù là bài tập đi chăng thì cũng phải có ứng dụng thực tế và cụ thể
(nếu không thì học rồi áp dụng vào đâu?)

chuot0106 · 1/5/15

Hau151978 đã viết:
Lập trình bằng VB thiên về lập trình ứng dụng nhiều hơn, vấn đề thuật toán thường là thứ yếu. Hồi học THPT về tin học có lẽ học thuật toán là thứ mình ghét nhất. Sau này khi VB ra đời khiến cho "ai cũng có thể trở thành lập trình viên", mọi thứ đã được VB làm hết.
Trở lại bài #86 của bạn chuot0106, code này đúng, ngắn gọn nhưng tốc độ chậm do mỗi lần tính 2, 2^2, 2^3... các số này đều tính lại từ đầu dẫn đến thừa nhiều phép nhân. Mình cải tiến code đó như sau:

Mã:

Function Binary2Decimal(ByVal b) As Long Dim tmp, s, i&, n& n = Len(b) tmp = 1 For i = 1 To n s = Mid(b, n - i + 1, 1) Binary2Decimal = Binary2Decimal + IIf(s = 0, 0, tmp) tmp = tmp * 2 Next End Function

Trong code này, biến tmp sẽ lưu các giá trị lũy thừa của 2, biến n lưu giá trị LEN(b) mà không dùng trực tiếp trong vòng lặp để tránh LEN(b) phải tính lại nhiều lần.

Đúng là lập trình chuyên nghiệp nên tính đến cả vấn đề thời gian. Tại em viết code xong thử các trường hợp thấy kết quả đúng là mừng lẳm rồi. Mà tại chuyển mấy con số nhị phân sang thập phân nên thời gian ít em mình không để ý đến vấn đề thời gian. Chứ nếu phải làm việc với dữ liệu lớn thì vấn đề tối ưu code là rất quan trọng.

phihndhsp · 2/5/15

chuot0106 đã viết:
Đúng là lập trình chuyên nghiệp nên tính đến cả vấn đề thời gian.

cái này không đúng lắm à nha, lập trình chuyên nghiệp phải tính đến việc tối ưu. Thời gian nhanh chưa phải là tối ưu nha bạn.
ví dụ đơn giản có 1 công việc cần làm
Cách 1 : chi phí bỏ ra 1 tỷ đồng cho thời gian 2 ngày
Cách 2 : chi phí bỏ ra 10 triệu đồng cho thời gian 1 tháng
bạn suy nghĩ như thế nào về 2 cách làm này

ChanhTQ@ · 2/5/15

[thongbao]Và thêm nữa: Dù là bài tập đi chăng thì cũng phải có ứng dụng thực tế và cụ thể
(nếu không thì học rồi áp dụng vào đâu?)[/thongbao]

/-)ây vẫn là vấn nạn của ngành GD Việt nam, mà ở những Trung tâm TH cũng khó mà tránh khỏi;

Người ta chỉ vin vào câu: Ở trường người ta chỉ chuyển giao những cái cơ bản; Còn chuyện áp dụng ngoài đời thì anh tự bơi!

Sau khi đã có bùa hộ mệnh, người ta đẩy những cái cơ bản đó đến vùng sâu vùng xa của lĩnh vực đó!

Còn các chàng sinh viên thì không biết không khí thở gồm 3 chất gì là chủ yếu nhất!
Hay sông Mê công chảy qua nước Malaixia.

Bài tập VBA - Macro (1 người xem)

Người dùng đang xem chủ đề này

Thành viên gắn bó

Thành viên mới

...nợ người, nợ đời...

Thành viên chính thức

Hãy cho rồi sẽ nhận!

Ngon Ngất Ngây

Hãy cho rồi sẽ nhận!

Thành viên chính thức

Hãy cho rồi sẽ nhận!

Thành viên chính thức

Ngon Ngất Ngây

Geotechnics

Thành viên chính thức

Hãy cho rồi sẽ nhận!

Thành viên chính thức

Thành viên mới

Thành viên chính thức

Huyền thoại GPE

KEEP WALKING

Thành viên hoạt động

Thành viên mới

Thành viên mới

File đính kèm

Thành viên gạo cội

File đính kèm

Thành viên mới

File đính kèm

Cạo Rồi Khỏi Gội

File đính kèm

Thành viên mới

Cạo Rồi Khỏi Gội

Thành viên mới

Thành viên mới

File đính kèm

Thành viên mới

|||||||||||||

File đính kèm

Thành viên mới

/(hông là gì!

File đính kèm

Thành viên gắn bó

/(hông là gì!

Thành viên gắn bó

Thành viên mới

Thành viên gắn bó

VBA & VB.NET for Excel & AutoCad

Thành viên tiêu biểu

Thành viên gạo cội

Thành viên gắn bó

/(hông là gì!

Thành viên gạo cội

File đính kèm

/(hông là gì!

Thành viên gắn bó

File đính kèm

Thành viên gạo cội

Thành viên gắn bó

Thành viên gạo cội

File đính kèm

0901452không62

File đính kèm

Thành viên gắn bó

Thành viên gạo cội

Thành viên gắn bó

Thành viên gắn bó

Thành viên gắn bó

File đính kèm

Thành viên gạo cội

Bad Excel Member

Bad Excel Member

Thành viên gạo cội

Thành viên gắn bó

Thành viên gạo cội

Thành viên gạo cội

Thành viên gắn bó

Thành viên gạo cội

Bad Excel Member

Thành viên gạo cội