Chuyên đề giải đáp những thắc mắc về code VBA (1 người xem)

Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
maytinhvp01

maytinhvp01

Thành viên thường trực
Tham gia
27/7/13
Bài viết
390
Được thích
179
Mình muốn nhờ giải thich câu lệnh " If Ran.Cells(d, c) > max Then max = Ran.Cells(d, c) "
trong ví du:
Public Function LonNhat(Ran As Range)
Dim max As Double, v As Integer, d As Integer, c As Integer
max = Ran.Cells(1, 1)
For d = 1 To Ran.Rows.Count
For c = 1 To Ran.Columns.Count
If Ran.Cells(d, c) > max Then max = Ran.Cells(d, c)
Next c
Next d
v = Tim(max, Ran)
LonNhat = max
End Function
-------------------------------------------------------
[INFO1]Thông báo:
Vì topic này:
http://www.giaiphapexcel.com/forum/...ải-thích-các-code-đề-nghị-các-bạn-gửi-vào-đây
đã quá dài nên BQT đóng lại.
Nay tôi mở topic mới với cùng chủ đề: GIẢI THÍCH NHỮNG THẮC MẮC VỀ CODE
Các bạn nếu có nhu cầu giải thích code, vui lòng post tại đây nhé
NDU96081631
[/INFO1]
 
Chỉnh sửa lần cuối bởi điều hành viên:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
giaiphap đã viết:
Bạn chưa mô tả chi tiết mục đích nên mình thiết kế Form thôi, việc còn lại thì bạn tự sửa code nhé.
Nhấp chuột vào đây để mở rộng...
Hi ad
Mục đích là mình muốn thiết kế 1 add-in dang các ribbon trên thanh menu, khi mình click vào thì nó hình ra như hình dưới
219902
Phục vụ cho công việc lập lại tiêu đề cho từng row dữ liệu. Nghĩa là trong file mình gửi, sheet đầu là sheet dữ liệu, 1 tiêu đề chung cho mọi người. Khi in phiếu lương phát cho mọi người thì mình phải copy tiêu đề đó cho từng người tương ứng.Đoạn code mình gửi là mình copy từ file ra.Mà file này của 1 ng trên mạng, giờ áp vào cty thì mỗi lần làm mình phải vào code sửa lại, nên giờ muốn nhờ ad giúp làm 1 cái add-in. khi làm chỉ click chọn thôi, ko có vào code sửa
Mong là hiểu dc ý mình diễn giải
 
Upvote 0
langtu020690 đã viết:
Hi ad
Mục đích là mình muốn thiết kế 1 add-in dang các ribbon trên thanh menu, khi mình click vào thì nó hình ra như hình dưới
View attachment 219902
Phục vụ cho công việc lập lại tiêu đề cho từng row dữ liệu. Nghĩa là trong file mình gửi, sheet đầu là sheet dữ liệu, 1 tiêu đề chung cho mọi người. Khi in phiếu lương phát cho mọi người thì mình phải copy tiêu đề đó cho từng người tương ứng.Đoạn code mình gửi là mình copy từ file ra.Mà file này của 1 ng trên mạng, giờ áp vào cty thì mỗi lần làm mình phải vào code sửa lại, nên giờ muốn nhờ ad giúp làm 1 cái add-in. khi làm chỉ click chọn thôi, ko có vào code sửa
Mong là hiểu dc ý mình diễn giải
Nhấp chuột vào đây để mở rộng...
Bạn phải giải thích rõ mới làm được.
Thứ nhất là khung màu đỏ thứ nhất (Titles Range) là nó lặp lại chổ nào trong file (Cụ thể hơn là nó lấy từ chổ nào của sheet data và chuyển sang sheet result thì nó nằm ở chổ nào?)
Thứ hai là khung màu đỏ thứ hai (Insert Range) là nó lặp lại chổ nào trong file (Cụ thể hơn là nó lấy từ chổ nào của sheet data và chuyển sang sheet result thì nó nằm ở chổ nào?)
Thứ ba là khung màu đỏ thứ ba (Interval rows) là nó lặp lại chổ nào trong file (Cụ thể hơn là nó lấy từ chổ nào của sheet data và chuyển sang sheet result thì nó nằm ở chổ nào?)
Giải thích cụ thể và chi tiết, nếu được thì giải thích rõ ràng càng tốt.
 
Upvote 0
giaiphap đã viết:
Bạn phải giải thích rõ mới làm được.
Thứ nhất là khung màu đỏ thứ nhất (Titles Range) là nó lặp lại chổ nào trong file (Cụ thể hơn là nó lấy từ chổ nào của sheet data và chuyển sang sheet result thì nó nằm ở chổ nào?)
Thứ hai là khung màu đỏ thứ hai (Insert Range) là nó lặp lại chổ nào trong file (Cụ thể hơn là nó lấy từ chổ nào của sheet data và chuyển sang sheet result thì nó nằm ở chổ nào?)
Thứ ba là khung màu đỏ thứ ba (Interval rows) là nó lặp lại chổ nào trong file (Cụ thể hơn là nó lấy từ chổ nào của sheet data và chuyển sang sheet result thì nó nằm ở chổ nào?)
Giải thích cụ thể và chi tiết, nếu được thì giải thích rõ ràng càng tốt.
Nhấp chuột vào đây để mở rộng...
Hi ad, em giải thích tí
1. Hình có 3 khung đỏ với file là ko có gì liên quan, ý e là trong file excel khi bấm nút màu tím thì nó tự chạy dữ liệu (từ sheet DATA), trong file excel có code VBA, nó định sẵn title từ đâu tới đâu, fix sẵn luôn. Giờ em muốn mình tạo 1 nút, khi bấm vào thì nó show cái form giống hình có 3 khung đỏ
a. Khung đỏ đầu: mình muốn tiêu đề nào lập lại thì mình khối chọn, làm vậy nó sẽ động chứ k tĩnh
b. Khung đỏ thứ 2: là dữ liệu nào muốn dc chèn tiêu đề vào, nhưng trong file có 91 người, thì 91 người sẽ dc chèn tiêu đề (xem sheet ketqua)
c. Khung đỏ 3: là muốn bao nhiêu dòng tiêu đề lập lại 1 lần. Như trong file thì mỗi row tiêu đề sẽ lập lại, vd tương lại mình sẽ có nhu cầu cứ sau 5 dòng thì tiêu đề lập lại
vd1: sau 1 row thì lập lại tiêu đề
ABCDEF->là tieu de
111111->du lieu dong 1
ABCDEF->là tieu de
222222->du lieu dong 2
vd2: sau 2 row thì lập lai tiêu đề
ABCDEF->là tieu de
111111->du lieu dong 1
222222->du lieu dong 2
ABCDEF->là tieu de
333333->du lieu dong 3
444444->du lieu dong 4
---
2. Hình có 3 khung đỏ thực chất nó là 1 chức năng trong 1 add-in tên là Kutools
Link tham khảo: https://www.extendoffice.com/documents/excel/4624-excel-header-row-print.html
Nhưng do cái này chỉ cho dùng thử, chứ dùng lâu phải mua key
3. Hiện tại em tạm gọi là có code lập lại tiêu đề rồi nên muốn nâng tiếp 1 bước thành dạng add-in, tạo 1 ribbon trên thanh menu,môi lần dùng chỉ cần click vào, và mình thao tác động, chứ k phải mỗi lần làm phải vào chỉnh sửa code.
Chắc đến đây ad hiểu ý em phải ko
 
Upvote 0
langtu020690 đã viết:
Hi ad, em giải thích tí
1. Hình có 3 khung đỏ với file là ko có gì liên quan, ý e là trong file excel khi bấm nút màu tím thì nó tự chạy dữ liệu (từ sheet DATA), trong file excel có code VBA, nó định sẵn title từ đâu tới đâu, fix sẵn luôn. Giờ em muốn mình tạo 1 nút, khi bấm vào thì nó show cái form giống hình có 3 khung đỏ
a. Khung đỏ đầu: mình muốn tiêu đề nào lập lại thì mình khối chọn, làm vậy nó sẽ động chứ k tĩnh
b. Khung đỏ thứ 2: là dữ liệu nào muốn dc chèn tiêu đề vào, nhưng trong file có 91 người, thì 91 người sẽ dc chèn tiêu đề (xem sheet ketqua)
c. Khung đỏ 3: là muốn bao nhiêu dòng tiêu đề lập lại 1 lần. Như trong file thì mỗi row tiêu đề sẽ lập lại, vd tương lại mình sẽ có nhu cầu cứ sau 5 dòng thì tiêu đề lập lại
vd1: sau 1 row thì lập lại tiêu đề
ABCDEF->là tieu de
111111->du lieu dong 1
ABCDEF->là tieu de
222222->du lieu dong 2
vd2: sau 2 row thì lập lai tiêu đề
ABCDEF->là tieu de
111111->du lieu dong 1
222222->du lieu dong 2
ABCDEF->là tieu de
333333->du lieu dong 3
444444->du lieu dong 4
---
2. Hình có 3 khung đỏ thực chất nó là 1 chức năng trong 1 add-in tên là Kutools
Link tham khảo: https://www.extendoffice.com/documents/excel/4624-excel-header-row-print.html
Nhưng do cái này chỉ cho dùng thử, chứ dùng lâu phải mua key
3. Hiện tại em tạm gọi là có code lập lại tiêu đề rồi nên muốn nâng tiếp 1 bước thành dạng add-in, tạo 1 ribbon trên thanh menu,môi lần dùng chỉ cần click vào, và mình thao tác động, chứ k phải mỗi lần làm phải vào chỉnh sửa code.
Chắc đến đây ad hiểu ý em phải ko
Nhấp chuột vào đây để mở rộng...
Bạn xem thử đúng yêu cầu của mình chưa nhé, nếu chưa đúng thì tối tính tiếp, có việc bận rồi.
 

File đính kèm

Upvote 0
giaiphap đã viết:
Bạn xem thử đúng yêu cầu của mình chưa nhé, nếu chưa đúng thì tối tính tiếp, có việc bận rồi.
Nhấp chuột vào đây để mở rộng...
Dear ad
Đầu tiên mình tks nhiều, cơ bản nó giống ý mình muốn rồi, nhưng kế qua hiện tại còn 1 tí lỗi nhỏ, nhờ ad fix dùm mình luôn nha.
219946
1. Như hình 1 thì sau khi mình chọn các đối tượng tương ứng trong form thì dòng dữ liệu bị lệch so với tiêu đề, vả lại giữa tiêu đề và dòng dữ liệu có khoảng trắng, bỏ luôn được không
2. Trong sheet Data có 91 người, ban đầu mình vd chỉ chọn cho tiêu đề lập lại 3 người đầu tiên thôi, file xuất quả đúng là chỉ có 3 người đó
nhưng 3 người đó bị lập đi lại lại nhiều lần, có cách nào chỉ hiện thị đúng số người mình chọn thôi.
4. Hiện tại mình chọn 3 người thì đồng nghĩa với việc sẽ có 3 cái tiêu đề cho 3 người đó, hiện tại 3 người chỉ có 1 tiêu đề
vd kết qua mong muốn là
AAAA->Tiêu đề
Người 1
AAAA->Tiêu đề
Người 2
AAAA->Tiêu đề
Người 3
----
cái này giống như phiếu lương con, mỗi tháng cắt ra đưa cho mỗi người 1 tờ giấy nhỏ để họ xem
Ad xem lại giúp mình.
 
Upvote 0

File đính kèm

Upvote 0
Em có biến X , em muốn so sánh biến x với vòng lặp for từ a1 đến a10 , nếu chỉ cần có 1 giá trị trong for = x thì ô b1 = "đúng"
- giúp e viết code với
 
Upvote 0
Bạn hãy cho biết thêm: Kiểu dữ liệu của biến X thân thương của bạn;
Tạm là vầy trong khi chờ đợi:
PHP: 
 Dim X, J as Long
 For J = 1 To 10
    If Cells(J, "A").Value = X Then
         [B1].Value="OK":      Exit For
    End If
 Next J
 
Upvote 0
SA_DQ đã viết:
Bạn hãy cho biết thêm: Kiểu dữ liệu của biến X thân thương của bạn;
Tạm là vầy trong khi chờ đợi:
PHP: 
Dim X, J as Long
For J = 1 To 10
    If Cells(J, "A").Value = X Then
         [B1].Value="OK":      Exit For
    End If
Next J
Nhấp chuột vào đây để mở rộng...
Bác Sa thức muộn vậy bác.
 
Upvote 0
Có anh cho em hỏi, về code này, bây giờ khi em xóa trắng data cũ và nhập vào data mới, thì dictonary cũng đồng thời bị mất hết keys và items cũ. Có cách nào để vẫn giữ lại item cũ trong Dic không ạ. Đồng thời em muốn xuất data bằng một sub khác, nhưng khi gọi lại các biến của sub DicItem thì lại không đượ, mong nhận được sự giúp đỡ của các anh.
Mã: 
Option Explicit
Sub DicItem()
Dim SArr, RArr, TmpArr, Dic1, MaxCols As Long
Dim i As Long, s As Long, EndR As Long, n As Long, Tmp As Long
Dim result()

Set Dic1 = CreateObject("Scripting.Dictionary")

With Dic1
EndR = Sheet1.[A100000].End(xlUp).Row
SArr = Sheet1.Range("A2:DF" & EndR).Value
For i = 1 To EndR - 1
    If Not .Exists(SArr(i, 105)) Then
        s = s + 1
        .Add SArr(i, 105), Array(SArr(i, 110), SArr(i, 18), SArr(i, 19))
        MaxCols = 1
    Else                                             '
        TmpArr = .item(SArr(i, 105))
        Tmp = UBound(.item(SArr(i, 105)))
        ReDim Preserve TmpArr(Tmp + 3)
        TmpArr(Tmp + 1) = SArr(i, 110)
        .item(SArr(i, 105)) = TmpArr
        TmpArr(Tmp + 2) = SArr(i, 18)
        .item(SArr(i, 105)) = TmpArr
        TmpArr(Tmp + 3) = SArr(i, 19)
        .item(SArr(i, 105)) = TmpArr
        If MaxCols < Tmp + 1 Then MaxCols = Tmp + 1
    End If
Next

Sheet8.[A4].Resize(s, 1) = Application.Transpose(.keys)
RArr = Sheet8.[A4].Resize(s, 1).Value

For i = 1 To .Count
Sheet8.Range("B" & i + 3).Resize(1, UBound(.item(RArr(i, 1))) + 1) = .item(RArr(i, 1))
Next

End With

End Sub
 
Upvote 0
harukenshiro đã viết:
Có anh cho em hỏi, về code này, bây giờ khi em xóa trắng data cũ và nhập vào data mới, thì dictonary cũng đồng thời bị mất hết keys và items cũ. Có cách nào để vẫn giữ lại item cũ trong Dic không ạ. Đồng thời em muốn xuất data bằng một sub khác, nhưng khi gọi lại các biến của sub DicItem thì lại không đượ, mong nhận được sự giúp đỡ của các anh.
Mã: 
Option Explicit
Sub DicItem()
Dim SArr, RArr, TmpArr, Dic1, MaxCols As Long
Dim i As Long, s As Long, EndR As Long, n As Long, Tmp As Long
Dim result()

Set Dic1 = CreateObject("Scripting.Dictionary")

With Dic1
EndR = Sheet1.[A100000].End(xlUp).Row
SArr = Sheet1.Range("A2:DF" & EndR).Value
For i = 1 To EndR - 1
    If Not .Exists(SArr(i, 105)) Then
        s = s + 1
        .Add SArr(i, 105), Array(SArr(i, 110), SArr(i, 18), SArr(i, 19))
        MaxCols = 1
    Else                                             '
        TmpArr = .item(SArr(i, 105))
        Tmp = UBound(.item(SArr(i, 105)))
        ReDim Preserve TmpArr(Tmp + 3)
        TmpArr(Tmp + 1) = SArr(i, 110)
        .item(SArr(i, 105)) = TmpArr
        TmpArr(Tmp + 2) = SArr(i, 18)
        .item(SArr(i, 105)) = TmpArr
        TmpArr(Tmp + 3) = SArr(i, 19)
        .item(SArr(i, 105)) = TmpArr
        If MaxCols < Tmp + 1 Then MaxCols = Tmp + 1
    End If
Next

Sheet8.[A4].Resize(s, 1) = Application.Transpose(.keys)
RArr = Sheet8.[A4].Resize(s, 1).Value

For i = 1 To .Count
Sheet8.Range("B" & i + 3).Resize(1, UBound(.item(RArr(i, 1))) + 1) = .item(RArr(i, 1))
Next

End With

End Sub
Nhấp chuột vào đây để mở rộng...
Bạn khai báo biến Public nhé.Khai báo ngoài sub.Bạn thử xem.
 
Upvote 0
Xin chào mọi người
tôi có làm 1 sub để tạo mô hình mẫu
dùng application.inputbox để lựa chọn ô sẽ lưu mô hình mẫu

1. Nhưng chỉ ra kết quả mong muốn trong ActiveSheet là đúng (hình 1)- Sheet2 là sheet hiện hoạt
2. Còn những sheets (sheet KetQua không được kích hoạt) khác thì định đạng không đúng, vì sao vậy? (hình 2)
3. Khác phục như thế nào?
220159
220160
 

File đính kèm

Upvote 0
vanmanhvcu đã viết:
Xin chào mọi người
tôi có làm 1 sub để tạo mô hình mẫu
dùng application.inputbox để lựa chọn ô sẽ lưu mô hình mẫu

1. Nhưng chỉ ra kết quả mong muốn trong ActiveSheet là đúng (hình 1)- Sheet2 là sheet hiện hoạt
2. Còn những sheets (sheet KetQua không được kích hoạt) khác thì định đạng không đúng, vì sao vậy? (hình 2)
3. Khác phục như thế nào?
View attachment 220159
View attachment 220160
Nhấp chuột vào đây để mở rộng...
Bạn bị sai ở tất cả các lệnh cells(..., ...), do lệnh cells nó hiểu là sheet hiện tại. Để khắc phục bạn thử sửa lại code thế này.
Mã: 
Sub MoHinhMau()
Dim DesTemp As Range, Des As Range

On Error Resume Next
    Set DesTemp = Application.InputBox("Ch" & ChrW(7885) & "n ô t" & ChrW(7841) & _
        "o mô hình m" & ChrW(7851) & "u", "Mô hình m" & ChrW(7851) & _
        "u", Default:=ActiveWindow.ActiveCell.Address, Type:=8)

If Err.Number <> 0 Then Exit Sub

Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

If IsArray(DesTemp) = True Then
   Set Des = DesTemp.Cells(1, 1)
Else
    Set Des = DesTemp
End If

With Des.Resize(11, 7)
    .Clear
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
End With
    With Des.Resize(9, 5)

        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    End With
    
    With Des.Offset(10, 1).Resize(, 4)
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
        .Interior.Color = 65535
    End With
    With Des.Offset(2, 6).Resize(7)
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
        .Interior.Color = 65535
    End With
    
    With Des.Offset(3, 2).Resize(6, 3)
        .Borders(xlEdgeLeft).Weight = xlMedium
        .Borders(xlEdgeRight).Weight = xlMedium
        .Borders(xlEdgeTop).Weight = xlMedium
        .Borders(xlEdgeBottom).Weight = xlMedium
        .Borders(xlInsideVertical).Weight = xlMedium
        .Borders(xlInsideHorizontal).Weight = xlMedium
        .Interior.Color = 65280
    End With
    
    With Des.Resize(2, 1)
        .MergeCells = True
        .FormulaR1C1 = "Day"
        .Font.Bold = True
    End With
    With Des.Resize(11, 7)
        .Cells(1, 2).FormulaR1C1 = "L" & ChrW(432) & ChrW(7907) & "ng (Kg)"
        .Cells(1, 2).Font.Bold = True
        .Cells(1, 3).FormulaR1C1 = "10000"
        .Cells(1, 4).FormulaR1C1 = "4900"
        .Cells(1, 5).FormulaR1C1 = "4900"
        .Cells(2, 2).FormulaR1C1 = "Kho"
        .Cells(2, 2).Font.Bold = True
        .Cells(2, 3).FormulaR1C1 = "1250"
        .Cells(2, 4).FormulaR1C1 = "652"
        .Cells(2, 5).FormulaR1C1 = "590"
        .Cells(3, 1).FormulaR1C1 = "Yêu C" & ChrW(7847) & "u" & Chr(10) & "(Kg)"
        .Cells(3, 1).Font.Bold = True
        .Cells(3, 2).FormulaR1C1 = "So luong" & Chr(10) & "-----------" & "Tip"
    
        .Cells(3, 2).Font.Bold = True
        .Cells(3, 3).FormulaR1C1 = "2"
        .Cells(3, 4).FormulaR1C1 = "6"
        .Cells(3, 5).FormulaR1C1 = "8"
        .Cells(3, 7).FormulaR1C1 = "K" & ChrW(7871) & "t qu" & ChrW(7843)
        .Cells(3, 7).Font.Bold = True
        .Cells(4, 1).FormulaR1C1 = "4000"
        .Cells(4, 2).FormulaR1C1 = "91"
        .Cells(4, 3).FormulaR1C1 = "0"
        .Cells(4, 4).FormulaR1C1 = "1"
        .Cells(4, 5).FormulaR1C1 = "0"
        .Cells(4, 7).FormulaR1C1 = "=RC[-5]*SUMPRODUCT(R[-3]C[-4]:R[-3]C[-2]*R[-1]C[-4]:R[-1]C[-2]*RC[-4]:RC[-2]/R[-2]C[-4]:R[-2]C[-2])"
        .Cells(5, 1).FormulaR1C1 = "2000"
        .Cells(5, 2).FormulaR1C1 = "127"
        .Cells(5, 3).FormulaR1C1 = "1"
        .Cells(5, 4).FormulaR1C1 = "0"
        .Cells(5, 5).FormulaR1C1 = "0"
        .Cells(5, 7).FormulaR1C1 = "=RC[-5]*SUMPRODUCT(R[-4]C[-4]:R[-4]C[-2]*R[-2]C[-4]:R[-2]C[-2]*RC[-4]:RC[-2]/R[-3]C[-4]:R[-3]C[-2])"
        .Cells(6, 1).FormulaR1C1 = "25000"
        .Cells(6, 2).FormulaR1C1 = "153"
        .Cells(6, 3).FormulaR1C1 = "2"
        .Cells(6, 4).FormulaR1C1 = "0"
        .Cells(6, 5).FormulaR1C1 = "2"
        .Cells(6, 7).FormulaR1C1 = "=RC[-5]*SUMPRODUCT(R[-5]C[-4]:R[-5]C[-2]*R[-3]C[-4]:R[-3]C[-2]*RC[-4]:RC[-2]/R[-4]C[-4]:R[-4]C[-2])"
        .Cells(7, 1).FormulaR1C1 = "5200"
        .Cells(7, 2).FormulaR1C1 = "173"
        .Cells(7, 3).FormulaR1C1 = "2"
        .Cells(7, 4).FormulaR1C1 = "0"
        .Cells(7, 5).FormulaR1C1 = "0"
        .Cells(7, 7).FormulaR1C1 = "=RC[-5]*SUMPRODUCT(R[-6]C[-4]:R[-6]C[-2]*R[-4]C[-4]:R[-4]C[-2]*RC[-4]:RC[-2]/R[-5]C[-4]:R[-5]C[-2])"
        .Cells(8, 1).FormulaR1C1 = "7200"
        .Cells(8, 2).FormulaR1C1 = "233"
        .Cells(8, 3).FormulaR1C1 = "2"
        .Cells(8, 4).FormulaR1C1 = "0"
        .Cells(8, 5).FormulaR1C1 = "0"
        .Cells(8, 7).FormulaR1C1 = "=RC[-5]*SUMPRODUCT(R[-7]C[-4]:R[-7]C[-2]*R[-5]C[-4]:R[-5]C[-2]*RC[-4]:RC[-2]/R[-6]C[-4]:R[-6]C[-2])"
        .Cells(9, 1).FormulaR1C1 = "42000"
        .Cells(9, 2).FormulaR1C1 = "277"
        .Cells(9, 3).FormulaR1C1 = "0"
        .Cells(9, 4).FormulaR1C1 = "2"
        .Cells(9, 5).FormulaR1C1 = "1"
        .Cells(9, 7).FormulaR1C1 = "=RC[-5]*SUMPRODUCT(R[-8]C[-4]:R[-8]C[-2]*R[-6]C[-4]:R[-6]C[-2]*RC[-4]:RC[-2]/R[-7]C[-4]:R[-7]C[-2])"
        .Cells(11, 2).FormulaR1C1 = "Thua"
        .Cells(11, 2).Font.Bold = True
        .Cells(11, 3).FormulaR1C1 = "=R[-9]C-SUMPRODUCT(R[-7]C[-1]:R[-2]C[-1]*R[-7]C:R[-2]C)"
        .Cells(11, 4).FormulaR1C1 = "=R[-9]C-SUMPRODUCT(R[-7]C[-2]:R[-2]C[-2]*R[-7]C:R[-2]C)"
        .Cells(11, 5).FormulaR1C1 = "=R[-9]C-SUMPRODUCT(R[-7]C[-3]:R[-2]C[-3]*R[-7]C:R[-2]C)"
        .Columns.AutoFit
        .Rows.AutoFit
        .Columns(6).EntireColumn.ColumnWidth = 3
    End With
    Des.Offset(, 2).Resize(, 3).NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
    Des.Offset(2).Resize(6).NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
    Des.Offset(2, 6).Resize(6).NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = False

End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
giaiphap đã viết:
Bạn bị sai ở tất cả các lệnh cells(..., ...), do lệnh cells nó hiểu là sheet hiện tại. Để khắc phục bạn thử sửa lại code thế này.
Mã: 
Sub MoHinhMau()
...............................................
    With Des.Resize(9, 5)
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    End With
...............................................
End Sub
Nhấp chuột vào đây để mở rộng...
Anh có tổng kết các cách tô viềng ở bài này VBA, tô viềng trong Excel
 
Upvote 0
Vài ngày trước mình có tải một file VBA chèn ảnh vào exel như thế này. Khi ở trạng thái wooksheet file vẫn hiện hình ảnh bình thường, tuy nhiên khi chuyển sang chế độ in thì file không hiển thị hình ảnh để in. Anh/Chị nào giúp em sửa lại code để in được hình với. Dja Em cảm ơn nhiều ạ!
 

File đính kèm

Upvote 0
giaiphap đã viết:
Bạn bị sai ở tất cả các lệnh cells(..., ...), do lệnh cells nó hiểu là sheet hiện tại. Để khắc phục bạn thử sửa lại code thế này.
Mã: 
Sub MoHinhMau()
Dim DesTemp As Range, Des As Range

On Error Resume Next
    Set DesTemp = Application.InputBox("Ch" & ChrW(7885) & "n ô t" & ChrW(7841) & _
        "o mô hình m" & ChrW(7851) & "u", "Mô hình m" & ChrW(7851) & _
        "u", Default:=ActiveWindow.ActiveCell.Address, Type:=8)

If Err.Number <> 0 Then Exit Sub

Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

If IsArray(DesTemp) = True Then
   Set Des = DesTemp.Cells(1, 1)
Else
    Set Des = DesTemp
End If

With Des.Resize(11, 7)
    .Clear
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
End With
    With Des.Resize(9, 5)

        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    End With
  
    With Des.Offset(10, 1).Resize(, 4)
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
        .Interior.Color = 65535
    End With
    With Des.Offset(2, 6).Resize(7)
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
        .Interior.Color = 65535
    End With
  
    With Des.Offset(3, 2).Resize(6, 3)
        .Borders(xlEdgeLeft).Weight = xlMedium
        .Borders(xlEdgeRight).Weight = xlMedium
        .Borders(xlEdgeTop).Weight = xlMedium
        .Borders(xlEdgeBottom).Weight = xlMedium
        .Borders(xlInsideVertical).Weight = xlMedium
        .Borders(xlInsideHorizontal).Weight = xlMedium
        .Interior.Color = 65280
    End With
  
    With Des.Resize(2, 1)
        .MergeCells = True
        .FormulaR1C1 = "Day"
        .Font.Bold = True
    End With
    With Des.Resize(11, 7)
        .Cells(1, 2).FormulaR1C1 = "L" & ChrW(432) & ChrW(7907) & "ng (Kg)"
        .Cells(1, 2).Font.Bold = True
        .Cells(1, 3).FormulaR1C1 = "10000"
        .Cells(1, 4).FormulaR1C1 = "4900"
        .Cells(1, 5).FormulaR1C1 = "4900"
        .Cells(2, 2).FormulaR1C1 = "Kho"
        .Cells(2, 2).Font.Bold = True
        .Cells(2, 3).FormulaR1C1 = "1250"
        .Cells(2, 4).FormulaR1C1 = "652"
        .Cells(2, 5).FormulaR1C1 = "590"
        .Cells(3, 1).FormulaR1C1 = "Yêu C" & ChrW(7847) & "u" & Chr(10) & "(Kg)"
        .Cells(3, 1).Font.Bold = True
        .Cells(3, 2).FormulaR1C1 = "So luong" & Chr(10) & "-----------" & "Tip"
  
        .Cells(3, 2).Font.Bold = True
        .Cells(3, 3).FormulaR1C1 = "2"
        .Cells(3, 4).FormulaR1C1 = "6"
        .Cells(3, 5).FormulaR1C1 = "8"
        .Cells(3, 7).FormulaR1C1 = "K" & ChrW(7871) & "t qu" & ChrW(7843)
        .Cells(3, 7).Font.Bold = True
        .Cells(4, 1).FormulaR1C1 = "4000"
        .Cells(4, 2).FormulaR1C1 = "91"
        .Cells(4, 3).FormulaR1C1 = "0"
        .Cells(4, 4).FormulaR1C1 = "1"
        .Cells(4, 5).FormulaR1C1 = "0"
        .Cells(4, 7).FormulaR1C1 = "=RC[-5]*SUMPRODUCT(R[-3]C[-4]:R[-3]C[-2]*R[-1]C[-4]:R[-1]C[-2]*RC[-4]:RC[-2]/R[-2]C[-4]:R[-2]C[-2])"
        .Cells(5, 1).FormulaR1C1 = "2000"
        .Cells(5, 2).FormulaR1C1 = "127"
        .Cells(5, 3).FormulaR1C1 = "1"
        .Cells(5, 4).FormulaR1C1 = "0"
        .Cells(5, 5).FormulaR1C1 = "0"
        .Cells(5, 7).FormulaR1C1 = "=RC[-5]*SUMPRODUCT(R[-4]C[-4]:R[-4]C[-2]*R[-2]C[-4]:R[-2]C[-2]*RC[-4]:RC[-2]/R[-3]C[-4]:R[-3]C[-2])"
        .Cells(6, 1).FormulaR1C1 = "25000"
        .Cells(6, 2).FormulaR1C1 = "153"
        .Cells(6, 3).FormulaR1C1 = "2"
        .Cells(6, 4).FormulaR1C1 = "0"
        .Cells(6, 5).FormulaR1C1 = "2"
        .Cells(6, 7).FormulaR1C1 = "=RC[-5]*SUMPRODUCT(R[-5]C[-4]:R[-5]C[-2]*R[-3]C[-4]:R[-3]C[-2]*RC[-4]:RC[-2]/R[-4]C[-4]:R[-4]C[-2])"
        .Cells(7, 1).FormulaR1C1 = "5200"
        .Cells(7, 2).FormulaR1C1 = "173"
        .Cells(7, 3).FormulaR1C1 = "2"
        .Cells(7, 4).FormulaR1C1 = "0"
        .Cells(7, 5).FormulaR1C1 = "0"
        .Cells(7, 7).FormulaR1C1 = "=RC[-5]*SUMPRODUCT(R[-6]C[-4]:R[-6]C[-2]*R[-4]C[-4]:R[-4]C[-2]*RC[-4]:RC[-2]/R[-5]C[-4]:R[-5]C[-2])"
        .Cells(8, 1).FormulaR1C1 = "7200"
        .Cells(8, 2).FormulaR1C1 = "233"
        .Cells(8, 3).FormulaR1C1 = "2"
        .Cells(8, 4).FormulaR1C1 = "0"
        .Cells(8, 5).FormulaR1C1 = "0"
        .Cells(8, 7).FormulaR1C1 = "=RC[-5]*SUMPRODUCT(R[-7]C[-4]:R[-7]C[-2]*R[-5]C[-4]:R[-5]C[-2]*RC[-4]:RC[-2]/R[-6]C[-4]:R[-6]C[-2])"
        .Cells(9, 1).FormulaR1C1 = "42000"
        .Cells(9, 2).FormulaR1C1 = "277"
        .Cells(9, 3).FormulaR1C1 = "0"
        .Cells(9, 4).FormulaR1C1 = "2"
        .Cells(9, 5).FormulaR1C1 = "1"
        .Cells(9, 7).FormulaR1C1 = "=RC[-5]*SUMPRODUCT(R[-8]C[-4]:R[-8]C[-2]*R[-6]C[-4]:R[-6]C[-2]*RC[-4]:RC[-2]/R[-7]C[-4]:R[-7]C[-2])"
        .Cells(11, 2).FormulaR1C1 = "Thua"
        .Cells(11, 2).Font.Bold = True
        .Cells(11, 3).FormulaR1C1 = "=R[-9]C-SUMPRODUCT(R[-7]C[-1]:R[-2]C[-1]*R[-7]C:R[-2]C)"
        .Cells(11, 4).FormulaR1C1 = "=R[-9]C-SUMPRODUCT(R[-7]C[-2]:R[-2]C[-2]*R[-7]C:R[-2]C)"
        .Cells(11, 5).FormulaR1C1 = "=R[-9]C-SUMPRODUCT(R[-7]C[-3]:R[-2]C[-3]*R[-7]C:R[-2]C)"
        .Columns.AutoFit
        .Rows.AutoFit
        .Columns(6).EntireColumn.ColumnWidth = 3
    End With
    Des.Offset(, 2).Resize(, 3).NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
    Des.Offset(2).Resize(6).NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
    Des.Offset(2, 6).Resize(6).NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = False

End Sub
Nhấp chuột vào đây để mở rộng...
Cám ơn Bạn đã giúp đỡ nhé.
Code chạy Ok rồi.
giaiphap đã viết:
Bạn bị sai ở tất cả các lệnh cells(..., ...), do lệnh cells nó hiểu là sheet hiện tại. Để khắc phục bạn thử sửa lại code thế này.
Mã: 
Sub MoHinhMau()
Dim DesTemp As Range, Des As Range

On Error Resume Next
    Set DesTemp = Application.InputBox("Ch" & ChrW(7885) & "n ô t" & ChrW(7841) & _
        "o mô hình m" & ChrW(7851) & "u", "Mô hình m" & ChrW(7851) & _
        "u", Default:=ActiveWindow.ActiveCell.Address, Type:=8)

If Err.Number <> 0 Then Exit Sub

Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

If IsArray(DesTemp) = True Then
   Set Des = DesTemp.Cells(1, 1)
Else
    Set Des = DesTemp
End If

With Des.Resize(11, 7)
    .Clear
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
End With
    With Des.Resize(9, 5)

        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    End With
   
    With Des.Offset(10, 1).Resize(, 4)
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
        .Interior.Color = 65535
    End With
    With Des.Offset(2, 6).Resize(7)
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
        .Interior.Color = 65535
    End With
   
    With Des.Offset(3, 2).Resize(6, 3)
        .Borders(xlEdgeLeft).Weight = xlMedium
        .Borders(xlEdgeRight).Weight = xlMedium
        .Borders(xlEdgeTop).Weight = xlMedium
        .Borders(xlEdgeBottom).Weight = xlMedium
        .Borders(xlInsideVertical).Weight = xlMedium
        .Borders(xlInsideHorizontal).Weight = xlMedium
        .Interior.Color = 65280
    End With
   
    With Des.Resize(2, 1)
        .MergeCells = True
        .FormulaR1C1 = "Day"
        .Font.Bold = True
    End With
    With Des.Resize(11, 7)
        .Cells(1, 2).FormulaR1C1 = "L" & ChrW(432) & ChrW(7907) & "ng (Kg)"
        .Cells(1, 2).Font.Bold = True
        .Cells(1, 3).FormulaR1C1 = "10000"
        .Cells(1, 4).FormulaR1C1 = "4900"
        .Cells(1, 5).FormulaR1C1 = "4900"
        .Cells(2, 2).FormulaR1C1 = "Kho"
        .Cells(2, 2).Font.Bold = True
        .Cells(2, 3).FormulaR1C1 = "1250"
        .Cells(2, 4).FormulaR1C1 = "652"
        .Cells(2, 5).FormulaR1C1 = "590"
        .Cells(3, 1).FormulaR1C1 = "Yêu C" & ChrW(7847) & "u" & Chr(10) & "(Kg)"
        .Cells(3, 1).Font.Bold = True
        .Cells(3, 2).FormulaR1C1 = "So luong" & Chr(10) & "-----------" & "Tip"
   
        .Cells(3, 2).Font.Bold = True
        .Cells(3, 3).FormulaR1C1 = "2"
        .Cells(3, 4).FormulaR1C1 = "6"
        .Cells(3, 5).FormulaR1C1 = "8"
        .Cells(3, 7).FormulaR1C1 = "K" & ChrW(7871) & "t qu" & ChrW(7843)
        .Cells(3, 7).Font.Bold = True
        .Cells(4, 1).FormulaR1C1 = "4000"
        .Cells(4, 2).FormulaR1C1 = "91"
        .Cells(4, 3).FormulaR1C1 = "0"
        .Cells(4, 4).FormulaR1C1 = "1"
        .Cells(4, 5).FormulaR1C1 = "0"
        .Cells(4, 7).FormulaR1C1 = "=RC[-5]*SUMPRODUCT(R[-3]C[-4]:R[-3]C[-2]*R[-1]C[-4]:R[-1]C[-2]*RC[-4]:RC[-2]/R[-2]C[-4]:R[-2]C[-2])"
        .Cells(5, 1).FormulaR1C1 = "2000"
        .Cells(5, 2).FormulaR1C1 = "127"
        .Cells(5, 3).FormulaR1C1 = "1"
        .Cells(5, 4).FormulaR1C1 = "0"
        .Cells(5, 5).FormulaR1C1 = "0"
        .Cells(5, 7).FormulaR1C1 = "=RC[-5]*SUMPRODUCT(R[-4]C[-4]:R[-4]C[-2]*R[-2]C[-4]:R[-2]C[-2]*RC[-4]:RC[-2]/R[-3]C[-4]:R[-3]C[-2])"
        .Cells(6, 1).FormulaR1C1 = "25000"
        .Cells(6, 2).FormulaR1C1 = "153"
        .Cells(6, 3).FormulaR1C1 = "2"
        .Cells(6, 4).FormulaR1C1 = "0"
        .Cells(6, 5).FormulaR1C1 = "2"
        .Cells(6, 7).FormulaR1C1 = "=RC[-5]*SUMPRODUCT(R[-5]C[-4]:R[-5]C[-2]*R[-3]C[-4]:R[-3]C[-2]*RC[-4]:RC[-2]/R[-4]C[-4]:R[-4]C[-2])"
        .Cells(7, 1).FormulaR1C1 = "5200"
        .Cells(7, 2).FormulaR1C1 = "173"
        .Cells(7, 3).FormulaR1C1 = "2"
        .Cells(7, 4).FormulaR1C1 = "0"
        .Cells(7, 5).FormulaR1C1 = "0"
        .Cells(7, 7).FormulaR1C1 = "=RC[-5]*SUMPRODUCT(R[-6]C[-4]:R[-6]C[-2]*R[-4]C[-4]:R[-4]C[-2]*RC[-4]:RC[-2]/R[-5]C[-4]:R[-5]C[-2])"
        .Cells(8, 1).FormulaR1C1 = "7200"
        .Cells(8, 2).FormulaR1C1 = "233"
        .Cells(8, 3).FormulaR1C1 = "2"
        .Cells(8, 4).FormulaR1C1 = "0"
        .Cells(8, 5).FormulaR1C1 = "0"
        .Cells(8, 7).FormulaR1C1 = "=RC[-5]*SUMPRODUCT(R[-7]C[-4]:R[-7]C[-2]*R[-5]C[-4]:R[-5]C[-2]*RC[-4]:RC[-2]/R[-6]C[-4]:R[-6]C[-2])"
        .Cells(9, 1).FormulaR1C1 = "42000"
        .Cells(9, 2).FormulaR1C1 = "277"
        .Cells(9, 3).FormulaR1C1 = "0"
        .Cells(9, 4).FormulaR1C1 = "2"
        .Cells(9, 5).FormulaR1C1 = "1"
        .Cells(9, 7).FormulaR1C1 = "=RC[-5]*SUMPRODUCT(R[-8]C[-4]:R[-8]C[-2]*R[-6]C[-4]:R[-6]C[-2]*RC[-4]:RC[-2]/R[-7]C[-4]:R[-7]C[-2])"
        .Cells(11, 2).FormulaR1C1 = "Thua"
        .Cells(11, 2).Font.Bold = True
        .Cells(11, 3).FormulaR1C1 = "=R[-9]C-SUMPRODUCT(R[-7]C[-1]:R[-2]C[-1]*R[-7]C:R[-2]C)"
        .Cells(11, 4).FormulaR1C1 = "=R[-9]C-SUMPRODUCT(R[-7]C[-2]:R[-2]C[-2]*R[-7]C:R[-2]C)"
        .Cells(11, 5).FormulaR1C1 = "=R[-9]C-SUMPRODUCT(R[-7]C[-3]:R[-2]C[-3]*R[-7]C:R[-2]C)"
        .Columns.AutoFit
        .Rows.AutoFit
        .Columns(6).EntireColumn.ColumnWidth = 3
    End With
    Des.Offset(, 2).Resize(, 3).NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
    Des.Offset(2).Resize(6).NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
    Des.Offset(2, 6).Resize(6).NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = False

End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn đã giúp đỡ
Code chạy Ok rồi.
 
Upvote 0
Bạn biết mục đích code ấy nó làm cái gì hôn? (không đi theo cái file áp dụng thì mục đích rỗng tuếch)
Người viết code lúc ấy chỉ có 1 mục đích chính trong đầu: từ dữ kiện đầu vào như thế, đạt yêu cầu đầu ra như này, với tốc độ nhanh nhất. Hết.
Nó không phải là loại code viết để người khác tìm hiểu và học hỏi.
 
Upvote 0
VetMini đã viết:
Bạn biết mục đích code ấy nó làm cái gì hôn? (không đi theo cái file áp dụng thì mục đích rỗng tuếch)
Người viết code lúc ấy chỉ có 1 mục đích chính trong đầu: từ dữ kiện đầu vào như thế, đạt yêu cầu đầu ra như này, với tốc độ nhanh nhất. Hết.
Nó không phải là loại code viết để người khác tìm hiểu và học hỏi.
Nhấp chuột vào đây để mở rộng...
mình đã kèm file theo đính kèm, mình vẫn ko hiểu ý bạn. ( Nó không phải là loại code viết để người khác tìm hiểu và học hỏi. ). Mình biết nó cao siêu, nhưng ko biết thì mĩnh vẫn hỏi tại nó cần cho công việc của mình..Thank bạn đã góp ý
 
Upvote 0
nguyenthotnot đã viết:
Chào các anh chị: Em có đoạn code của GPE em mới đang học VBA em coppy đoạn code về phục vụ cho công việc của em nhưng em vẫn ko hiểu ý nghĩa của các đoạn code sau mong các anh chị có thể giải thích cặn kẽ giúp em với tại sao mình khai báo là biến sArr() và dArr(), fDate, eDate, Rws, Col, với các mục tô màu đỏ mong các anh chị giúp em hiểu ý nghĩa với thank các anh chị biến J,K,R mình có thể khai báo biến khác được ko các anh chị
Public Sub Gpe_Loc()
Dim sArr(), dArr(), i As Long, J As Long, K As Long, R As Long, Rws As Long, Col As Long, fDate As Long, eDate As Long, SName As String
SName = Range("C5").Value
fDate = Range("C6").Value
eDate = IIf(Range("C7").Value = Empty, Date, Range("C7").Value)
sohd = "*" & UCase(Range("E6").Value) & "*"
Col = 57
With Sheets(SName)
R = .Range("B10000").End(xlUp).Row
If R > 8 Then
sArr = .Range("A9:A" & R).Resize(, Col).Value
Rws = UBound(sArr)
ReDim dArr(1 To R, 1 To Col)
For i = 1 To Rws
If sArr(i, 2) >= fDate Then
If sArr(i, 2) <= eDate Then
If UCase(sArr(i, 3)) Like UCase(sohd) Then
K = K + 1
dArr(K, 1) = K
For J = 2 To Col
dArr(K, J) = sArr(i, J)
Next J
End If
End If
End If
End With
Range("A9").Resize(1000, Col).ClearContents
If K Then Range("A9").Resize(K, Col) = dArr
End Sub

public Sub Gpe_TH()
Dim sArr(), dArr(), Col(), tArr(), Ngay As Date, ShName As String
Dim C As Long, i As Long, J As Long, K As Long, n As Long, R As Long, Rws As Long
Ngay = Range("C4").Value
Col = Range("D8:Z8").Value
C = UBound(Col, 2)
tArr = Range("C9", Range("C9").End(xlDown)).Value
ReDim dArr(1 To UBound(tArr), 1 To C)
For n = 1 To UBound(tArr)
ShName = tArr(n, 1)
With Sheets(ShName)
R = .Range("B50000").End(xlUp).Row
If R > 8 Then
sArr = .Range("A9:B" & R).Resize(, 57).Value
Rws = UBound(sArr)
For i = Rws To 1 Step -1
If sArr(i, 2) <= Ngay Then
For J = 1 To C
If Col(1, J) <> Empty Then dArr(n, J) = sArr(i, Col(1, J))
Next J
Exit For
End If
Next i
End If
End With
Next n
Range("D9").Resize(1000, C).ClearContents
Range("D9").Resize(n - 1, C) = dArr
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$4" Then Gpe_TH
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C5:K7")) Is Nothing Then Gpe_Loc
End Sub

em xin kèm theo file đính kèm mong các anh chị chỉ giúp đỡ dùm
Nhấp chuột vào đây để mở rộng...
Đến biến bạn còn không biết ý nghĩa của nó thì làm sao mà hiểu được code.Bạn phải hiểu cơ bản rồi mới tìm hiểu thêm.Bạn đọc tài liệu mảng xong vào tìm hiểu code này nhé.
 
Upvote 0
nguyenthotnot đã viết:
... Mình biết nó cao siêu ...
Nhấp chuột vào đây để mở rộng...
Chả có cao siêu chỗ nào cả. Tôi nói nó "không phải là loại code viết để người khác tìm hiểu và học hỏi" là bởi vì nó được viết theo kinh nghiệm của người viết. Mà kinh nghiệm thì phải tự tích luỹ.
 
Upvote 0
Nhờ các bạn giúp mình sửa lỗi trong file này với ah, chạy VBA báo lỗi mình chưa biết xử lý thế nào, thanks
 

File đính kèm

Upvote 0
luanvm123 đã viết:
Nhờ các bạn giúp mình sửa lỗi trong file này với ah, chạy VBA báo lỗi mình chưa biết xử lý thế nào, Cảm ơn
Nhấp chuột vào đây để mở rộng...
Thêm câu lệnh này nữa.Đó trước câu ở dưới.
Mã: 
Sheet2.Activate
 Sheet2.Range(Cells(3, 4 + 28 * (a - 1)), Cells(3, 28 * a + 4)) = "T" & a
 
Upvote 0
Gửi các anh chị. Em mới tự học và làm thử code trên file excel công việc của em. Có đoạn code tự làm này mà không hiểu sao nó làm file của em tính toán chậm quá ạ. Mọi người giúp em khắc phục được không ạ
Nhập tháng làm việc
Mã: 
Private Sub Workbook_Open()
Dim thang As Integer
Dim nam As Integer
Application.Calculation = xlCalculationManual
On Error Resume Next
thang = InputBox("chon thang lam viec", , Month(Date))
On Error GoTo 0
Sheets("th").Range("y1").Value = thang
If thang > 12 Or thang <= 0 Then
   MsgBox "Chua chon thang", vbCritical
   Sheets("th").Range("y1").Value = Month(Date)
End If
On Error Resume Next
nam = InputBox("chon nam lam viec", , Year(Date))
On Error GoTo 0
Sheets("th").Range("z1").Value = nam
If nam <= 2007 Then
   MsgBox "Chua chon nam", vbCritical
   Sheets("th").Range("z1").Value = Year(Date)
End If
Application.Calculation = xlCalculationAutomatic
End Sub
Module1:
Mã: 
Function thanglmv() As Date
Application.Volatile
thanglmv = DateSerial(Sheets("th").Range("z1").Value, Sheets("th").Range("y1").Value, 15)
End Function
Code này em dùng để nhập tháng làm việc sau đó lấy hàm lấy ngày tháng làm việc đó dùng trong công thức khoảng 300 dòng.
 
Upvote 0
Xin giúp đỡ về vòng lặp For..Next
Mã: 
Sub tinhdinhluong()
Dim i, j, a, b
For i = 4 To 1500 'lay ten model sheet B.O.M
     For a = 6 To 50 'so sanh ten model o sheet 8
         For j = 4 To 1500 'lay code o sheet B.O.M
             For b = 7 To 650
              If Sheet2.Cells(i, 2).Value = Sheet8.Cells(5, a).Value And Sheet2.Cells(j, 3).Value = Sheet8.Cells(b, 3).Value Then
              Sheet8.Cells(b, a).Value = Sheet2.Cells(j, 9).Value
              End If
             Next b
         Next j
     Next a
Next i
End Sub
sau khi em chạy thì file bị dow, xin các anh chị giúp đỡ ạ
 
Upvote 0
duonghychi đã viết:
Xin giúp đỡ về vòng lặp For..Next
Mã: 
Sub tinhdinhluong()
Dim i, j, a, b
For i = 4 To 1500 'lay ten model sheet B.O.M
     For a = 6 To 50 'so sanh ten model o sheet 8
         For j = 4 To 1500 'lay code o sheet B.O.M
             For b = 7 To 650
              If Sheet2.Cells(i, 2).Value = Sheet8.Cells(5, a).Value And Sheet2.Cells(j, 3).Value = Sheet8.Cells(b, 3).Value Then
              Sheet8.Cells(b, a).Value = Sheet2.Cells(j, 9).Value
              End If
             Next b
         Next j
     Next a
Next i
End Sub
sau khi em chạy thì file bị dow, xin các anh chị giúp đỡ ạ
Nhấp chuột vào đây để mở rộng...
Theo kết quả mình tính sơ bộ thì cần:63.317.948.672 vòng lặp để chạy xong 4 vòng lặp For của bạn chưa tính đến chuyện sử lý số liệu.Máy nó chạy cũng hết hơi.
​
 
Upvote 0
duonghychi đã viết:
em muốn ở sheet "CHIA BTP" sẽ lấy giá trị ở cột "QTY" tại sheet B.O.M ạ, xin bác giúp đỡ
Nhấp chuột vào đây để mở rộng...
Bạn thử nhé.
Mã: 
Sub tinh()
    Dim arr, i As Long, j As Long, data, lr As Long, dic As Object, a As Long, b As Long, dk As String
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("CHIA BTP")
         lr = .Range("C" & Rows.Count).End(xlUp).Row
         If lr < 7 Then Exit Sub
         .Range("F7:AJ" & lr).ClearContents
         arr = .Range("C4:AJ" & lr).Value
         For i = 4 To UBound(arr)
             dk = arr(i, 1) & "#" & "I"
             dic.Item(dk) = i
         Next i
         For i = 4 To UBound(arr, 2)
             dk = arr(2, i) & "#" & "M"
             dic.Item(dk) = i
         Next i
   End With
   With Sheets("B.O.M")
      j = .Range("B" & Rows.Count).End(xlUp).Row
      data = .Range("B4:I" & j).Value
      For i = 1 To UBound(data)
              dk = data(i, 1) & "#" & "M"
              a = dic.Item(dk)
              If a Then
                 dk = data(i, 2) & "#" & "I"
                 b = dic.Item(dk)
                 If b Then
                    arr(b, a) = arr(b, a) + data(i, 8)
                 End If
             End If
     Next i
  End With
  With Sheets("CHIA BTP")
       .Range("C4:AJ" & lr).Value = arr
  End With
End Sub
 
Upvote 0
snow25 đã viết:
Bạn thử nhé.
Mã: 
Sub tinh()
    Dim arr, i As Long, j As Long, data, lr As Long, dic As Object, a As Long, b As Long, dk As String
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("CHIA BTP")
         lr = .Range("C" & Rows.Count).End(xlUp).Row
         If lr < 7 Then Exit Sub
         .Range("F7:AJ" & lr).ClearContents
         arr = .Range("C4:AJ" & lr).Value
         For i = 4 To UBound(arr)
             dk = arr(i, 1) & "#" & "I"
             dic.Item(dk) = i
         Next i
         For i = 4 To UBound(arr, 2)
             dk = arr(2, i) & "#" & "M"
             dic.Item(dk) = i
         Next i
   End With
   With Sheets("B.O.M")
      j = .Range("B" & Rows.Count).End(xlUp).Row
      data = .Range("B4:I" & j).Value
      For i = 1 To UBound(data)
              dk = data(i, 1) & "#" & "M"
              a = dic.Item(dk)
              If a Then
                 dk = data(i, 2) & "#" & "I"
                 b = dic.Item(dk)
                 If b Then
                    arr(b, a) = arr(b, a) + data(i, 8)
                 End If
             End If
     Next i
  End With
  With Sheets("CHIA BTP")
       .Range("C4:AJ" & lr).Value = arr
  End With
End Sub
Nhấp chuột vào đây để mở rộng...
Em cảm ơn ạ, bác giúp em 1 xíu nữa là em muốn nhân các giá trị tìm kiếm được cho số lượng ở dòng 6, dưới mỗi tên model thì làm như thế nào ạ.
 
Upvote 0
duonghychi đã viết:
Em cảm ơn ạ, bác giúp em 1 xíu nữa là em muốn nhân các giá trị tìm kiếm được cho số lượng ở dòng 6, dưới mỗi tên model thì làm như thế nào ạ.
Nhấp chuột vào đây để mở rộng...
Bạn thử.
Mã: 
Sub tinh()
    Dim arr, i As Long, j As Long, data, lr As Long, dic As Object, a As Long, b As Long, dk As String
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("CHIA BTP")
         lr = .Range("C" & Rows.Count).End(xlUp).Row
         If lr < 7 Then Exit Sub
         .Range("F6:AJ" & lr).ClearContents
         arr = .Range("C4:AJ" & lr).Value
         For i = 4 To UBound(arr)
             dk = arr(i, 1) & "#" & "I"
             dic.Item(dk) = i
         Next i
         For i = 4 To UBound(arr, 2)
             dk = arr(2, i) & "#" & "M"
             dic.Item(dk) = i
         Next i
   End With
   With Sheets("B.O.M")
      j = .Range("B" & Rows.Count).End(xlUp).Row
      data = .Range("B4:I" & j).Value
      For i = 1 To UBound(data)
              dk = data(i, 1) & "#" & "M"
              a = dic.Item(dk)
              If a Then
                 dk = data(i, 2) & "#" & "I"
                 b = dic.Item(dk)
                 If b Then
                    arr(b, a) = arr(b, a) + data(i, 8)
                    If data(i, 8) <> 0 Then If arr(3, a) = 0 Then arr(3, a) = data(i, 8) Else arr(3, a) = arr(3, a) * data(i, 8)
                 End If
             End If
     Next i
  End With
  With Sheets("CHIA BTP")
       .Range("C4:AJ" & lr).Value = arr
  End With
End Sub
 
Upvote 0
Code lỗi rồi ạ, bác có thể insert ý định của mỗi biến không ạ, em muốn hiểu được code của bác, :D
 
Upvote 0
Dạ nhờ các anh chị giúp đỡ e với ạ.
file 1 và file 2 có cùng 1 kiểu dữ liệu. Nhưng khi load vào file baocao thì chỉ có mỗi file 1 khi load vào thì cột E sheet data có dữ liệu, còn file 2 thì không có. E ngồi xem code cả chiều rồi mà vẫn không hiểu lý do tại sao load file 2 vào thì cột E không có dữ liệu.
Rất mong anh chị xem qua giúp e với ạ
Em chỉ đoán có gì đó sai trong đoạn

Mã: 
If Len(arrtam) >= 131 And Len(arrtam) < 160 Then
                kq(i, 1) = Trim(Left(arrtam, 17))
                kq(i, 2) = Trim(Mid(arrtam, 18, 4))
                kq(i, 3) = Val(Trim(Mid(arrtam, 22, 15)))
                kq(i, 4) = Trim(Mid(arrtam, 37, 50))
                kqtam = Trim(Mid(arrtam, 40, 150))
                kqtam1 = Trim(Replace(Trim(Mid(kqtam, InStrRev(kqtam, " ") - 21, 21)), ".", ""))
                If IsNumeric(kqtam1) Then
                    kq(i, 6) = Trim(Replace(Trim(Mid(kqtam, InStrRev(kqtam, " ") - 35, 35)), ".", ""))
                Else
                    vitri = InStrRev(kqtam, " ", Len(kqtam) - 41)
                    kq(i, 5) = Trim(Replace(Mid(kqtam, vitri, 20), ".", ""))
                End If
                If Right(arrtam, 1) = "-" Then
                    kq(i, 7) = "-" & Trim(Replace(Replace(Right(kqtam, Len(kqtam) - InStrRev(kqtam, " ")), ".", ""), "-", ""))
                Else
                    kq(i, 7) = Trim(Replace(Right(kqtam, Len(kqtam) - InStrRev(kqtam, " ")), ".", ""))
                End If
            End If
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
xin chào mọi người
Mình có một vấn đề mong mọi người giúp :
Mình muốn tạo 1 nút bấm : mà nếu bấm lần 1 sẽ ẩn các sheet chỉ định trong exel, ấn lần 2 sẽ hiển lại
Hiện tại mình chỉ có thể tạo 2 nút bấm với 2 lệnh này.
mình đã search tìm hiểu nhưng chưa được !
 
Upvote 0
lehuuhaint đã viết:
xin chào mọi người
Mình có một vấn đề mong mọi người giúp :
Mình muốn tạo 1 nút bấm : mà nếu bấm lần 1 sẽ ẩn các sheet chỉ định trong exel, ấn lần 2 sẽ hiển lại
Hiện tại mình chỉ có thể tạo 2 nút bấm với 2 lệnh này.
mình đã search tìm hiểu nhưng chưa được !
Nhấp chuột vào đây để mở rộng...
Bạn giải thích rõ ra chứ.Và có file với code.Mọi người còn biết.Sheets chỉ định ẩn thì nó cố định hay là thay đổi thường xuyên.
 
Upvote 0
snow25 đã viết:
Bạn giải thích rõ ra chứ.Và có file với code.Mọi người còn biết.Sheets chỉ định ẩn thì nó cố định hay là thay đổi thường xuyên.
Nhấp chuột vào đây để mở rộng...

Bạn xem giúp nha
GỘP 2 NÚT ẨN HIỆN THÀNH 1 NÚT
=>ẤN LẦN 1 LÀ ẨN,LẦN 2 LÀ HIỆN
mình thấy người ta làm, mà mình ko biết làm sao
 

File đính kèm

Upvote 0
Code:

With Sheet gì đó
If .Visible = xlSheetVeryHidden Then
.Visible = True
Else
.Visible = Not .Visible
End If
End With
 
Upvote 0
iamnobika đã viết:
Gửi các anh chị. Em mới tự học và làm thử code trên file excel công việc của em. Có đoạn code tự làm này mà không hiểu sao nó làm file của em tính toán chậm quá ạ. Mọi người giúp em khắc phục được không ạ
Nhập tháng làm việc
Mã: 
Private Sub Workbook_Open()
Dim thang As Integer
Dim nam As Integer
Sheets("luong").Activate
Application.Calculation = xlCalculationManual
On Error Resume Next
thang = InputBox("chon thang lam viec", , Month(Date))
On Error GoTo 0
Range("b2").Value = thang
If thang > 12 Or thang <= 0 Then
   MsgBox "Chua chon thang", vbCritical
   Range("b2").Value = Month(Date)
End If
On Error Resume Next
nam = InputBox("chon nam lam viec", , Year(Date))
On Error GoTo 0
Range("b3").Value = nam
If nam <= 2007 Then
   MsgBox "Chua chon nam", vbCritical
   Range("b3").Value = Year(Date)
End If
Application.Calculation = xlCalculationSemiautomatic
End Sub
End Sub
Module1:
Mã: 
Function thanglv() As Date
Application.Volatile
thanglv = DateSerial(Range("b3").Value, Range("b2").Value, 15)
End Function
Code này em dùng để nhập tháng làm việc sau đó lấy hàm lấy ngày tháng làm việc đó dùng trong công thức khoảng 300 dòng.
Nhấp chuột vào đây để mở rộng...
ai giúp em tìm ra nguyên nhân file của em bị chậm khi dùng code này, mỗi khi em copy dữ liệu đi và đến file nó calculator lâu được không ạ.
Em quên gửi file
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Mã: 
Sub laycode()
Dim a As Long, arrBOM, dic As Object, code, I As Long
Set dic = CreateObject("scripting.dictionary")
a = Sheet2.Range("c" & Rows.Count).End(xlUp).Row 'lay so dong cuoi cung
arrBOM = Sheet2.Range("c4:i" & a).Value ' kich thuoc mang BOM
For I = 1 To UBound(arrBOM) ' bien I de xet mang
If arrBOM(I, 1) <> "" And Left(arrBOM(I, 1), 2) <> "4-" Then
  If Not dic.Exists(arrBOM(I, 1)) Then
  code = arrBOM(I, 1)
  dic.Add arrBOM(I, 1), True
End If
End If
Next I
Sheet6.Cells(7, 3).Resize(2000).Value = code
End Sub
Em đang tập tành viết 1 code, các code trên đều là đi mượn của mọi người ạ, hiện giờ đang bị lỗi là nó chỉ trả về 1 giá trị thôi ạ, mọi người cho em hỏi nó đang sai ở đâu ạ. em xin cảm ơn!
 
Upvote 0
duonghychi đã viết:
Mã: 
Sub laycode()
Dim a As Long, arrBOM, dic As Object, code, I As Long
Set dic = CreateObject("scripting.dictionary")
a = Sheet2.Range("c" & Rows.Count).End(xlUp).Row 'lay so dong cuoi cung
arrBOM = Sheet2.Range("c4:i" & a).Value ' kich thuoc mang BOM
For I = 1 To UBound(arrBOM) ' bien I de xet mang
If arrBOM(I, 1) <> "" And Left(arrBOM(I, 1), 2) <> "4-" Then
  If Not dic.Exists(arrBOM(I, 1)) Then
  code = arrBOM(I, 1)
  dic.Add arrBOM(I, 1), True
End If
End If
Next I
Sheet6.Cells(7, 3).Resize(2000).Value = code
End Sub
Em đang tập tành viết 1 code, các code trên đều là đi mượn của mọi người ạ, hiện giờ đang bị lỗi là nó chỉ trả về 1 giá trị thôi ạ, mọi người cho em hỏi nó đang sai ở đâu ạ. em xin cảm ơn!
Nhấp chuột vào đây để mở rộng...
Bạn sai ở chỗ cái code kia nó chỉ nhận 1 giá trị thôi mà.Bạn xem code.
Mã: 
Sub laycode()
Dim a As Long, arrBOM, dic As Object, code, I As Long, b As Long
Set dic = CreateObject("scripting.dictionary")
a = Sheet2.Range("c" & Rows.Count).End(xlUp).Row 'lay so dong cuoi cung
arrBOM = Sheet2.Range("c4:i" & a).Value ' kich thuoc mang BOM
ReDim code(1 To UBound(arrBOM), 1 To 1)
For I = 1 To UBound(arrBOM) ' bien I de xet mang
If arrBOM(I, 1) <> "" And Left(arrBOM(I, 1), 2) <> "4-" Then
  If Not dic.Exists(arrBOM(I, 1)) Then
  b = b + 1
  code(b, 1) = arrBOM(I, 1)
  dic.Add arrBOM(I, 1), True
End If
End If
Next I
Sheet6.Cells(7, 3).Resize(2000).Value = code
End Sub
 
Upvote 0
NHờ xem code Advanced Filter tại sao không chạy
Cùng 1 cấu trúc mà không hiểu sao Advanced Filter của em không chạy. Các anh chị chỉ giúp nguyên nhân với. Em đã thử 1 số tình huống mà vẫn không chịu ra kết quả như mong muốn. Em cảm ơn.
 

File đính kèm

Upvote 0
MinhKhai đã viết:
NHờ xem code Advanced Filter tại sao không chạy
Cùng 1 cấu trúc mà không hiểu sao Advanced Filter của em không chạy. Các anh chị chỉ giúp nguyên nhân với. Em đã thử 1 số tình huống mà vẫn không chịu ra kết quả như mong muốn. Em cảm ơn.
Nhấp chuột vào đây để mở rộng...
Hình như "mà thì là" cột G sheet "TongHop" không phải Date.
 
Upvote 0
MinhKhai đã viết:
NHờ xem code Advanced Filter tại sao không chạy
Cùng 1 cấu trúc mà không hiểu sao Advanced Filter của em không chạy. Các anh chị chỉ giúp nguyên nhân với. Em đã thử 1 số tình huống mà vẫn không chịu ra kết quả như mong muốn. Em cảm ơn.
Nhấp chuột vào đây để mở rộng...
Bạn phạm 3 lỗi sơ đẳng.

1. Cột G không chứa ngày tháng. Nó chỉ là ngày tháng cho mắt của bạn nhưng với Excel đó là text - ngày tháng nhái.

Biến thành ngày tháng theo chuẩn Excel: chọn TongHop!G4:G10000 -> Data -> text to columns -> Next -> Next -> chọn option Date -> bên cạnh chọn DMY -> Finish

2. Không có cái gọi là "=<". Chỉ có cái gọi là "<=". Sửa Data!R3

3. Sửa thành
Mã: 
Sheet3.Range("B3:J10000").AdvancedFilter 2, Sheet4.[O2:R3], Sheet4.[B3:H3]

Để như cũ bạn chỉ nhận được cột B.
 
Upvote 0
batman1 đã viết:
Bạn phạm 3 lỗi sơ đẳng.

1. Cột G không chứa ngày tháng. Nó chỉ là ngày tháng cho mắt của bạn nhưng với Excel đó là text - ngày tháng nhái.

Biến thành ngày tháng theo chuẩn Excel: chọn TongHop!G4:G10000 -> Data -> text to columns -> Next -> Next -> chọn option Date -> bên cạnh chọn DMY -> Finish

2. Không có cái gọi là "=<". Chỉ có cái gọi là "<=". Sửa Data!R3

3. Sửa thành
Mã: 
Sheet3.Range("B3:J10000").AdvancedFilter 2, Sheet4.[O2:R3], Sheet4.[B3:H3]

Để như cũ bạn chỉ nhận được cột B.
Nhấp chuột vào đây để mở rộng...
Cảm ơn anh đã giải đáp.
cả 3 lỗi anh nêu đều đúng. Tuy nhiên cái lỗi thứ 3 như anh thấy ở cái Sub Test_AdvFilter cho sheet Ví dụ 2 vẫn chạy được là sao nhỉ ?
 
Upvote 0

File đính kèm

Upvote 0
Ai chỉ mình dòng code để thay đổi chiều cao tất cả các dòng thuộc vùng đã select với
Ví dụ chiều cao mỗi dòng tăng lên 2 đơn vị
 
Upvote 0
leonguyenz đã viết:
Select nhiều dòng thì nó lấy chiều cao dòng trên cùng làm chuẩn, sao lại không có tác dụng gì?
Nhấp chuột vào đây để mở rộng...
Vầy mới được Thảo ơi

Selection.RowHeight = Cells(Selection.Row, 1).RowHeight + 2

Theo kinh nghiệm thì khi mình chọn 2 dòng không cùng độ cao thì code nó ngu ngu sao ấy
 
Upvote 0
Mã: 
Sub tinhtong()
Dim total, soluong, i As Long, x As Long, y As Long, a As Long
soluong = Sheet6.Range("f7:bz604").Value
For i = 1 To 1000
    For x = 1 To 100
    y = y + soluong(i, x).Value
    Next x
    total(a, 1) = y
Next i
Sheet6.Range("e7:e1000").Value = total(y, 1)

End Sub
Các bác xem giúp em các tính tổng trong 1 mảng với ạ, em làm mãi vẫn chưa được.
 
Upvote 0
duonghychi đã viết:
Mã: 
Sub tinhtong()
Dim total, soluong, i As Long, x As Long, y As Long, a As Long
soluong = Sheet6.Range("f7:bz604").Value
For i = 1 To 1000
    For x = 1 To 100
    y = y + soluong(i, x).Value
    Next x
    total(a, 1) = y
Next i
Sheet6.Range("e7:e1000").Value = total(y, 1)

End Sub
Các bác xem giúp em các tính tổng trong 1 mảng với ạ, em làm mãi vẫn chưa được.
Nhấp chuột vào đây để mở rộng...
Cái total của bạn là mảng hả.Mà biến a của bạn là gì.
 
Upvote 0
iamnobika đã viết:
Có phải do dùng hàm "thanglv" trong module em làm ra xử lý lệnh qua nhiều dòng quá nó làm chậm file đi phải không ạ?
Nhấp chuột vào đây để mở rộng...
File gốc chậm do 2 nguyên nhân:
- Hàm tự tạo bằng VBA thường chạy chậm hơn hàm của Excel
- Hàm "thanglv" sử dụng cho nhiều Ô, khi có sự thay đổi của file sẽ tính lại giá trị của hàm, nên chạy rất nhiều lần làm chậm file, dùng Ô B1 lưu trữ giá trị nên chỉ chạy 1 lần.
 
Upvote 0
Tối kỵ trong lập trình là dùng biến mà chưa khởi tạo trị mặc định ban đầu cho nó. Ông VBA này lanh chanh quá, làm người code dễ dãi, có thói quen xấu theo.
Tui đọc mấy cái code mà thiếu option explicit và thiếu khởi tạo biến thì rất khó chịu, xóa liền.
 
Upvote 0
duonghychi đã viết:
Xin các bác viết code giúp em ạ,
Nhấp chuột vào đây để mở rộng...
"Quăng" file lên cũng phải giải thích làm cái gì, trên cột nào... chứ thế này thì chắc phải hỏi anh Google xem code bạn viết là muốn làm cái gì.
Nếu anh Google trả lời được chắc sẽ có người giúp bạn.
 
Upvote 0
Ba Tê đã viết:
"Quăng" file lên cũng phải giải thích làm cái gì, trên cột nào... chứ thế này thì chắc phải hỏi anh Google xem code bạn viết là muốn làm cái gì.
Nếu anh Google trả lời được chắc sẽ có người giúp bạn.
Nhấp chuột vào đây để mở rộng...
Dạ, em muốn tính tổng cho các dòng từ vùng "f7:bz604" kết quả, hiện thị tại "e7:e604, mong bác giúp em các viết code cho mảng ạ. Em cảm ơn!
 
Upvote 0
duonghychi đã viết:
Dạ, em muốn tính tổng cho các dòng từ vùng "f7:bz604" kết quả, hiện thị tại "e7:e604, mong bác giúp em các viết code cho mảng ạ. Em cảm ơn!
Nhấp chuột vào đây để mở rộng...
Dùng tạm cái này xem.
PHP: 
Option Explicit

Public Sub sGpe()
Dim sArr(), dArr(), I As Long, J As Long, R As Long, Col As Long
With Sheets("TINH NVL")
    Col = .Range("XFD5").End(xlToLeft).Column - 5
    R = .Range("C100000").End(xlUp).Row - 6
    sArr = .Range("F7").Resize(R, Col).Value
    R = UBound(sArr)
    ReDim dArr(1 To R, 1 To 1)
    For I = 1 To R
        For J = 1 To Col
            dArr(I, 1) = dArr(I, 1) + sArr(I, J)
        Next J
    Next I
    .Range("E7").Resize(R) = dArr
End With
End Sub
 
Upvote 0
Ba Tê đã viết:
Dùng tạm cái này xem.
PHP: 
Option Explicit

Public Sub sGpe()
Dim sArr(), dArr(), I As Long, J As Long, R As Long, Col As Long
With Sheets("TINH NVL")
    Col = .Range("XFD5").End(xlToLeft).Column - 5
    R = .Range("C100000").End(xlUp).Row - 6
    sArr = .Range("F7").Resize(R, Col).Value
   [B] R = UBound(sArr)[/B]
    ReDim dArr(1 To R, 1 To 1)
    For I = 1 To R
        For J = 1 To Col
            dArr(I, 1) = dArr(I, 1) + sArr(I, J)
        Next J
    Next I
    .Range("E7").Resize(R) = dArr
End With
End Sub
Nhấp chuột vào đây để mở rộng...
Cho mình hỏi dòng in đậm có cần thiết ko, và thêm nó có tác dụng gì, và nếu ko có thì sao ạ? Tại mình bỏ cái dòng đó code vẫn chạy bình thường ạ!
Xin cảm ơn
 
Upvote 0
:) Sorry
 
Lần chỉnh sửa cuối:
Upvote 0
thanhphuongvip đã viết:
Cho mình hỏi dòng in đậm có cần thiết ko, và thêm nó có tác dụng gì, và nếu ko có thì sao ạ? Tại mình bỏ cái dòng đó code vẫn chạy bình thường ạ!
Xin cảm ơn
Nhấp chuột vào đây để mở rộng...
ThangCuAnh đã viết:
Chạy bình thường mà có đúng không vậy bạn ?
Bỏ đi thì R = 0, chạy ra sao thì bạn tìm hiểu tiếp :D
Nhấp chuột vào đây để mở rộng...
Câu này hả bạn hay câu nào.
Option Explicit
 
Upvote 0
Sorry, em lại nhanh nhẩu đoảng, nhầm. Do không đọc kỹ đoạn code phía trên.
Mã: 
.....
R = .Range("C100000").End(xlUp).Row - 6
....
R = UBound(sArr)
 
Lần chỉnh sửa cuối:
Upvote 0
thanhphuongvip đã viết:
Vậy cuối cùng là chỗ đó sao vậy Snow nhỉ?
Nhấp chuột vào đây để mở rộng...
R = .Range("C100000").End(xlUp).Row - 6 ' (A)
sArr = .Range("F7").Resize(R, Col).Value ' (B)
R = UBound(sArr) ' (C)
Nhấp chuột vào đây để mở rộng...

(A) R là số dòng có dữ liệu trên sheet tính từ dòng 7. Vd. dữ liệu tới dòng 11 thì
.Range("C100000").End(xlUp).Row trả về 11, vậy R = 11 - 6 = 5 (5 dòng dữ liệu: 7, 8, 9, 10, 11)

(B) các dòng dữ liệu trên sheet tính từ dòng 7 được nhập vào mảng sArr. Tức trên sheet có R dòng dữ liệu, và trong sArr cũng có R dòng.

(C) R bằng chỉ số trên của dòng trong mảng sArr. Do chỉ số được tính từ 1 nên R cũng chính là số dòng trong mảng sArr, mà số dòng trong sArr bằng số dòng có dữ liệu trên sheet tính từ dòng 7. Vậy R ở (C) bằng R ở (A). Chính vì thế bạn bỏ R ở (C) thì code vẫn chạy vì R đã được xác định tại (A).

R ở điểm (C) thừa nhưng nếu có thì bạn nhìn ra ngay, khỏi suy nghĩ kỹ, là mảng dArr có cùng kích thước với mảng sArr. Thế thôi.

Ở đây code ngắn nên bạn nhìn thấy ngay là R ở (C) không cần nhưng nếu code dài mà (C) nằm ở cuối thì bạn không nhìn thấy ngay được. Có R ở (C) thì dứt khoát dArr có cùng kích thước với mảng sArr.
 
Upvote 0
Dear All.
Mọi người cho e hỏi có cách nào khi sử dụng FileSystemScriptingObject để GetFolder lấy NameFile trong thư mục thì nó bỏ qua các file ẩn và các file tạm đang mở không ạ.
Cám ơn rất nhiều .
 
Upvote 0
Không bạn, Files trả về hết tất cả các File object với mọi thuộc tính. Bạn muốn lọc thì dùng GetAttr hay File.Attributes để loại ra với vbHidden = Hidden = 2
Còn nếu file đang mở thì có nhiều loại đang mở: mở share read, mở share write, mở exclusive (độc quyền). Bạn có thể dùng Open statement: Open xxx As Read Write Lock Read Write để thử mở độc quyền file đó. Nhớ bẫy lỗi On Error. Nếu mở được thì file đó chưa mở, không được thì có thằng process khác đang mở rồi.
Còn muốn biết file đó đang được process nào mở, mở như thế nào, quyền ra sao, security attribues ra sao thì phải dùng NT API. Cách này hơi lòng vòng, phức tạp. Các tool phổ biến xem được vấn đề này là Process Explorer, Process Hacker...
 
Upvote 0
Chào ace
Mình muốn hỏi một chút về hàm Evaluate và Replace. Mình có hai câu hỏi

Câu hỏi 1:
Mình hiện đang học VBA và có đoạn code lồng hàm Evaluate và Replace. Mình ko hiểu rõ lắm cách mà code chạy ở đây.
Code:
Mã: 
Sub iteration()
 Dim i As Integer
 Dim x As Double
 
 Dim fxn As String
 
 fxn = InputBox("Enter function form x = f(x)")
 x = InputBox("Enter inital guess")
 
 For i = 1 To 20
  x = Evaluate(Replace(fxn, "x", x))
 Next i

 MsgBox ("Solution is " & FormatNumber(x, 2))
End Sub

Mình tạm hiểu phần Replace tức replace các giá trị x trong hàm f(x) đã nhập từ string thành x. Còn phần evaluate trước đó thì mình không hiểu lắm. Ace ai hiểu giải thích giúp mình với.

Câu hỏi 2:
Giả sử mình có hàm f(x,y) thì nếu muốn làm tương tự như trên thì phần Evaluate(Replace(...)) mình phải viết thế nào. Mình coi syntax của nó thì chỉ có dạng như sau:
Mã: 
Replace ( string1, find, replacement, [start, [count, [compare]]] )

Cảm ơn ace
 
Upvote 0
quocturtle đã viết:
Chào ace
...Cảm ơn ace
Nhấp chuột vào đây để mở rộng...
Hỏi thì đừng viết tắt. Lập trình là phải đọc một đống viết tắt rồi, bây giờ còn bắt phải đoán thêm câu hỏi viết tắt nữa?

quocturtle đã viết:
...
Câu hỏi 1:
Mình hiện đang học VBA và có đoạn code lồng hàm Evaluate và Replace. Mình ko hiểu rõ lắm cách mà code chạy ở đây.
Code:
... x = Evaluate(Replace(fxn, "x", x))
...

Mình tạm hiểu phần Replace tức replace các giá trị x trong hàm f(x) đã nhập từ string thành x. Còn phần evaluate trước đó thì mình không hiểu lắm. Ace ai hiểu giải thích giúp mình với.
...
Nhấp chuột vào đây để mở rộng...
Evaluate là hàm tính biểu thức dạng chuỗi sang kết quả số. Ví dụ cho biểu thức "123+456" thì Evaluate("123+456") sẽ cho kết quả là 579.
Ở trên nếu fxn là "x*x + 3*x + 5" và x là 2 thì hàm replace sẽ nạp thành Evaluate("2*2 + 3*2 + 5"); được kết quả là 15.

quocturtle đã viết:
...
For i = 1 To 20
x = Evaluate(Replace(fxn, "x", x))
Next i
...
Câu hỏi 2:
Giả sử mình có hàm f(x,y) thì nếu muốn làm tương tự như trên thì phần Evaluate(Replace(...)) mình phải viết thế nào. Mình coi syntax của nó thì chỉ có dạng như sau:
Mã: 
Replace ( string1, find, replacement, [start, [count, [compare]]] )
Nhấp chuột vào đây để mở rộng...
Bài tập trên là nạp trị mới vào biểu thức cũ để tính tiếp, đại khái là cách giải fixed-point iteration.
Nếu muốn f(x,y) thì bạn phải lục lại lý thuyết toán để tìm cách giải ấy (nếu có)
 
Upvote 0
Mình có file excel cần sort cột C theo thứ tự từ nhỏ đến lớn (số lô từ nhỏ đến lớn), rất mong được các anh chị giúp đỡ. Mình đã sort nhưng nó không đúng ý. Nó ra kq như sau:
19/NV1/CN/1040
19/NV1/CN/243
19/NV1/CN/313
Nghĩa là nó chỉ sort được số đầu tiên của các cụm số 1040, 243, 313, trong khi mình muốn nó sắp xếp theo thứ tự
19/NV/CN/243
19/NV1/CN/313
19/NV1/CN/1040
 

File đính kèm

Upvote 0
phamdinhnha đã viết:
Mình có file excel cần sort cột C theo thứ tự từ nhỏ đến lớn (số lô từ nhỏ đến lớn), rất mong được các anh chị giúp đỡ. Mình đã sort nhưng nó không đúng ý. Nó ra kq như sau:
19/NV1/CN/1040
19/NV1/CN/243
19/NV1/CN/313
Nghĩa là nó chỉ sort được số đầu tiên của các cụm số 1040, 243, 313, trong khi mình muốn nó sắp xếp theo thứ tự
19/NV/CN/243
19/NV1/CN/313
19/NV1/CN/1040
Nhấp chuột vào đây để mở rộng...
Cái này nó đang sort theo thứ tự từ trái qua phải nhé.Nếu bạn muốn sort theo kiểu như vậy thì tách nó ra mà sort nhé.
 
Upvote 0
NHưng trong cột C của file em đó còn có những lô 19/NV1/GĐ/243, nghĩa là có những lô CN và GĐ trùng số nhau nên muốn tách theo chuỗi ký tự của số lô. anh chị giúp . Hay ai đó có thể dùng code vba để sort
Bài đã được tự động gộp:

NHưng trong cột C của file em đó còn có những lô 19/NV1/GĐ/243, nghĩa là có những lô CN và GĐ trùng số nhau nên muốn tách theo chuỗi ký tự của số lô. anh chị giúp . Hay ai đó có thể dùng code vba để sort
Bài đã được tự động gộp:

snow25 đã viết:
Cái này nó đang sort theo thứ tự từ trái qua phải nhé.Nếu bạn muốn sort theo kiểu như vậy thì tách nó ra mà sort nhé.
Nhấp chuột vào đây để mở rộng...
NHưng trong cột C của file em đó còn có những lô 19/NV1/GĐ/243, nghĩa là có những lô CN và GĐ trùng số nhau nên muốn tách theo chuỗi ký tự của số lô. anh chị giúp .
 
Upvote 0
phamdinhnha đã viết:
NHưng trong cột C của file em đó còn có những lô 19/NV1/GĐ/243, nghĩa là có những lô CN và GĐ trùng số nhau nên muốn tách theo chuỗi ký tự của số lô. anh chị giúp . Hay ai đó có thể dùng code vba để sort
Bài đã được tự động gộp:

NHưng trong cột C của file em đó còn có những lô 19/NV1/GĐ/243, nghĩa là có những lô CN và GĐ trùng số nhau nên muốn tách theo chuỗi ký tự của số lô. anh chị giúp . Hay ai đó có thể dùng code vba để sort
Bài đã được tự động gộp:


NHưng trong cột C của file em đó còn có những lô 19/NV1/GĐ/243, nghĩa là có những lô CN và GĐ trùng số nhau nên muốn tách theo chuỗi ký tự của số lô. anh chị giúp .
Nhấp chuột vào đây để mở rộng...
Bạn đưa dữ liệu "giống thật" khoảng 10 dòng (đủ loại chuỗi có thể có) và 1 bảng kết quả mẫu bạn muốn có bằng thủ công xem.
 
Upvote 0
Em nhờ anh Ba Tê và các anh chị khác giúp đỡ. Em xin gửi lại file, trong đó có 2 sheets trước và sau sắp xếp
 

File đính kèm

Upvote 0
Em chào cả nhà
Hiện tại em có file excel để coppy dữ liệu từ sheet file nguon sang sheet Htoan, cách thức copy như sau ạ:
- Lọc ở cột bồi thường nhượng của sheet file nguồn, nếu có giá trị khác blank thì copy sang sheet Htoan TK nợ là 1368211, tk có là 1313111, bên cột phân loại note là bồi thường nhượng. Các dữ liệu khác thì copy từ dữ liệu tương ứng ở sheet file nguồn, ngoài ra một số biến đổi công thức ở sheet Htoan thì anh chị xem hộ em công thức ở sheet này luôn ạ
- Lọc ở cột phí nhượng nếu có dữ liệu khác blank thì copy và điền thêm bên sheet Htoan tai khoan nợ là 3313111 , tk có 1368211 đối với phí nhượng, bên cột phân loại note lại là phí nhượng
- Đối với hoa hồng nhượng tương tự.
Mong anh chị giúp đỡ em ạ
 

File đính kèm

Upvote 0
Xin chào!.
Hiện tại mình có viết 1 đoạn code đơn giản để Thay thế Giá trị dữ liệu từ Excel vào Word.
Tuy Nhiên, hiện tại code này không thực hiện được trong phần nội dung header và Footer của Word. Rất mong được hỗ trợ.
Sub Replace_Word_Excel()
Dim Rws As Byte
'optimize macro
Application.ScreenUpdating = False
Application.EnableEvents = False
'Define the end rows to circulate

Range("B1").Select
Rws = Range(Selection, Selection.End(xlDown)).Count
'word execution
On Error Resume Next
With CreateObject("Word.Application") 'Open word
.Visible = True
file = [a1]
Doc = .documents.Open(ThisWorkbook.Path & "\" & file & ".docx")
.documents(ThisWorkbook.Path & "\" & file & ".docx").SaveAs Filename:=ThisWorkbook.Path & "\" & Cells(2, 2) & ".docx"
For i = 3 To Rws 'Run Cells replacement

a = Range("B" & i).Value

.Selection.Replace a, , , , , , , , , Sheets("Replacedlist").Range("C" & i).Value, 2 'Replace word from B by C value

Next

.documents(ThisWorkbook.Path & "\" & Cells(2, 2) & ".docx").Close (True)

.Quit

End With

End Sub
 
Upvote 0
Chào các bác !
Trên GPE có 1 đoạn code chèn hình vào cell và autofit. Với cell đơn lẻ thì code ok nhưng với 2 cell merge làm 1 (vd A1 và A2 merge lại thì code này chỉ chèn hình vừa với cell A1 thôi chứ không phải là Cell A1+A2 đã merge
Nhờ các bác edit giúp code giúp mình với. Xin cảm ơn
Sub ChenHinh()
'chen hinh vao cell cho truoc
Dim PicList() As Variant
Dim PicFormat As String
Dim rng As Range
Dim sShape As Shape
Dim Col As Variant
Dim Row As Variant
Dim i As Long

On Error Resume Next
PicList = Application.GetOpenFilename(PicFormat, MultiSelect:=True)
Col = Application.ActiveCell.Column
If IsArray(PicList) Then
Row = Application.ActiveCell.Row
For i = LBound(PicList) To UBound(PicList)
Set rng = Cells(Row, Col)
Set sShape = ActiveSheet.Shapes.AddPicture(PicList(i), msoFalse, msoCTrue, rng.Left, rng.Top, rng.Width, rng.Height)
Row = Row + 1

ActiveSheet.DrawingObjects.Placement = xlMoveAndSize
Application.CommandBars("Format Object").visible = False
Next i
End If
End Sub
 
Upvote 0
Achye đã viết:
Chào các bác !
Trên GPE có 1 đoạn code chèn hình vào cell và autofit. Với cell đơn lẻ thì code ok nhưng với 2 cell merge làm 1 (vd A1 và A2 merge lại thì code này chỉ chèn hình vừa với cell A1 thôi chứ không phải là Cell A1+A2 đã merge
Nhấp chuột vào đây để mở rộng...
Bạn dùng Sub InsertPicture của tôi trong bài #9 ở link sau

www.giaiphapexcel.com

Giúp gán hình từ Folder vào B2 sheet Trend theo số hồ sơ

Mình đang làm file quản lý hồ sơ nhân viên. Sếp yêu cầu khi nhập mã nhân viên (sheet Trend) sẽ hiện lên đầy đủ thông tin của nhân viên và ảnh. Ảnh của nhân viên mình lưu ở 1 folder riêng. Phần thông tin của nhân viên mình đã làm được, còn phần ảnh mình không biết làm như nào, nhờ mọi người chỉ...
www.giaiphapexcel.com www.giaiphapexcel.com

Có nhiều lựa chọn:
- vùng chèn ảnh là 1 cell hoặc vùng nhiều cell, hoặc nhập vào ActiveCell
- chèn ảnh kích thước thực
- chèn ảnh vừa khít vùng. Vừa khít thường không tốt. Vd. vùng chèn là hình vuông trong đó ảnh A là hình chữ nhật dài > cao, ảnh B là hình chữ nhật dài < cao. Lúc này nếu chèn vừa khít thì ảnh A và B sẽ được phóng to/thu nhỏ ở 2 chiều không như nhau nên nhìn sẽ bị "méo"
- chèn ảnh Center. Lúc này ảnh chèn luôn cân đối - 2 chiều phóng to/thu nhỏ theo cùng một tỷ lệ.
- có thể chỉ chèn link (ảnh luôn phải giữ trên đĩa. Khi mang sang máy khác phải mang ảnh theo) hoặc chèn vĩnh viễn (sau khi chèn có thể xóa ảnh trên đĩa. Khi mang sang máy khác không cần mang ảnh theo)
 
Upvote 0
namtoche28 đã viết:
Em chào cả nhà
Hiện tại em có file excel để coppy dữ liệu từ sheet file nguon sang sheet Htoan, cách thức copy như sau ạ:
- Lọc ở cột bồi thường nhượng của sheet file nguồn, nếu có giá trị khác blank thì copy sang sheet Htoan TK nợ là 1368211, tk có là 1313111, bên cột phân loại note là bồi thường nhượng. Các dữ liệu khác thì copy từ dữ liệu tương ứng ở sheet file nguồn, ngoài ra một số biến đổi công thức ở sheet Htoan thì anh chị xem hộ em công thức ở sheet này luôn ạ
- Lọc ở cột phí nhượng nếu có dữ liệu khác blank thì copy và điền thêm bên sheet Htoan tai khoan nợ là 3313111 , tk có 1368211 đối với phí nhượng, bên cột phân loại note lại là phí nhượng
- Đối với hoa hồng nhượng tương tự.
Mong anh chị giúp đỡ em ạ
Nhấp chuột vào đây để mở rộng...
Không ai giúp em bài này với ạ
 
Upvote 0
Mình muốn viết 1 đoạn code xử lý công việc như sau: Trong vùng sắp xếp dữ liệu của mình có những cell tham chiếu giá trị đến nhau. Nếu ta sắp xếp dữ liệu thì những link này sẽ link sai vị trí hết. Có cách nào xử lý việc này không?
Cảm ơn các bạn!
Ví dụ: sắp xếp dữ liệu theo cột từ D4 đến D9
 

File đính kèm

Upvote 0
leviethungtoht đã viết:
Mình muốn viết 1 đoạn code xử lý công việc như sau: Trong vùng sắp xếp dữ liệu của mình có những cell tham chiếu giá trị đến nhau. Nếu ta sắp xếp dữ liệu thì những link này sẽ link sai vị trí hết. Có cách nào xử lý việc này không?
Cảm ơn các bạn!
Ví dụ: sắp xếp dữ liệu theo cột từ D4 đến D9
Nhấp chuột vào đây để mở rộng...

Bạn quên save Marco enable rồi
 
Upvote 0
Giải thích giúp em câu lệnh này với ạ:
Rich (BB code): 
Dic.Item(a(i, 1) & "|" & a(i, 3)) = a(i, 4)
 
Upvote 0
Chào mọi người
Mình có một function đơn giản như sau:

Mã: 
Function func01(str As String, X As Variant)
func01 = Evaluate(Replace(str, "x", X))
End Function

Cơ bản thì hàm này dùng như sau: ví dụ mình có hàm f(x) = ln(x) + x^2. Mình muốn tính f(x) với x = 2 chẳng hạng thì mình có 2 cách
Cách 1: =Ln(A1) + A1^2. Với A1=2 <-- Cái này ko có gì đáng nói
Cách 2: dùng hàm mình viết func01. Mình nhập là =func01("ln(x)+x^2",A1) trong đó A1=2. Hàm func01 sẽ thay thế các giá trị x bằng giá trị ở A1, tức 2. Kết quả ra tương đương với cách 1.

Tuy nhiên bây giờ có 1 vấn đề mà mấy ngày nay mình hỏi khắp nơi ko ra là như vậy:

nếu hàm func01("x",A1) tức là A1 thế nào thì func01 trả ra thế đấy.
Vấn đề bắt đầu từ đây,
1. Hàm func01 xài được với mọi trường hợp, mọi hàm trừ duy nhất khi là func01("x",A1) và giá trị A1=1. Chỉ duy nhất trường hợp này trả ra giá trị lỗi. Mọi người xem Cell C12 trong file Excel đính kèm giúp mình

2. Nếu các bạn mởi 1 sheet độc lập, viết lại hàm func01 y chang thì.
2.1 Dừng lại ở đây thì hàm func01 trả ra giá trị đúng với func01("x",A1)=1 với A1=1
2.2 Nếu thêm UserForm các thứ thì lỗi lại bị. ???

Ruốt cuộc mình chẳng biết vấn đề là từ đâu ra nữa
Anh em bạn bè gần xa, có ai cao thủ vụ này giúp mình với.

Cảm ơn mọi người
 

File đính kèm

Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

U
VB tính tổng số cell trong 1 hàng có cùng màu với 1 cell so sánh ở cột khác (1 người xem)
Trả lời
4
Đọc
17
uronmapu
U
T
VBA LẤY THÔNG TIN TRÊN TỜ KHAI NHẬP KHẨU (2 người xem)
Trả lời
10
Đọc
569
binhminh1408
B
H
Giúp mình ghép nhiều file thành một file. (1 người xem)
Trả lời
10
Đọc
366
hanhnguyen120221cuty
H
H
Tổng hợp Công Nợ theo Công trình (3 người xem)
Trả lời
12
Đọc
107
LOGANWover
L
Nguyễn Duy Tuân
Hàm BS COMBINLIST Liệt kê các giá trị tổ hợp, chỉnh hợp, chỉnh hợp không lặp | Add-in A-Tools v10
    • Yêu thích
    • Thích
Trả lời
17
Đọc
1K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
2
  • Question Question
Hỏi cách in phiếu điều tra PCGD-XMC từ file dữ liệu mẫu xuất ra từ hệ thống PCGD-XMC của Bộ GD
    • Thích
Trả lời
18
Đọc
1K
Hoàng Tuấn 868
H
HeSanbi
  • Đã giải quyết
ZaloExcel v2.95: Gửi tin nhắn, hình ảnh, bảng, biểu đồ, tập tin, tạo nhóm, thu thập tin nhắn (2 người xem)
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
60
Đọc
19K
HeSanbi
HeSanbi
L
File Excel nặng chưa tìm được lý do ở đâu . Mong các bác hỗ trợ ! (2 người xem)
Trả lời
3
Đọc
52
Hoàng Tuấn 868
H
J
Xử lý các file Excel bị nặng sau nhiều năm sử dụng
Trả lời
12
Đọc
2K
lưu tuấn dũng
L
hongphuong1997
Nên sử dụng Chatgpt hay Copilot (1 người xem)
    • Yêu thích
Trả lời
11
Đọc
238
befaint
befaint
D
XIN HỖ TRỢ VỀ FILE EXCEL TỔNG HỢP ĐIỂM THI ĐUA
Trả lời
0
Đọc
34
DươngH193
D
L
Xin file lịch báo giảng tự động
Trả lời
2
Đọc
81
linedraw84
L
H
Xin File Theo dõi công nợ
Trả lời
0
Đọc
59
HangktGTN
H
N
Tạo file Excel dùng VBA để lấy và nối dữ liệu từ các files excel
Trả lời
39
Đọc
6K
hungnv_thct2026
H
S
Power BI. Một quá trình đòi hỏi sự kiên nhẫn.
Trả lời
4
Đọc
209
SteveNguyen1991
S
SA_DQ
  • Question Question
Bài tập VBA cho những người rỗi. . . đủ thứ!
    • Ngạc nhiên
    • Cười
    • Yêu thích
Trả lời
21
Đọc
754
Phuocam
Phuocam
H
  • Question Question
Dò tìm giá trị từ bảng khác theo cột
Trả lời
5
Đọc
113
ptm0412
ptm0412
L
Cách bật/tắt đèn led thứ 3 trên bàn phím cơ
Trả lời
1
Đọc
72
HUONGHCKT
H
C
Không thể group cột trong excel
Trả lời
10
Đọc
12K
ptm0412
ptm0412
A
  • Question Question
Em nhờ anh/chị/em/chú/bác giúp em viết code tổng hợp dữ liệu. em tính công thức nó nặng quá. em cám ơn
Trả lời
14
Đọc
999
Hoàng Tuấn 868
H
Xem thêm…

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

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom