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

maytinhvp01 · 31/7/13

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]

langtu020690 · 25/6/19

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

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

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

giaiphap · 25/6/19

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

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.

langtu020690 · 25/6/19

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.

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

giaiphap · 25/6/19

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

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.

langtu020690 · 26/6/19

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.

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.

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.

langtu020690 · 26/6/19

Hi ad
Kết quả mong muốn thế này

giaiphap · 26/6/19

langtu020690 đã viết:
Hi ad
Kết quả mong muốn thế này
View attachment 219954

Tôi giúp lần này nếu chưa đúng thì bạn lập topic mới nhé, vì đây là mục giải thích code. bạn xem file và Video.

langtu020690 · 26/6/19

giaiphap đã viết:
Tôi giúp lần này nếu chưa đúng thì bạn lập topic mới nhé, vì đây là mục giải thích code. bạn xem file và Video.

Dear ad
Em đã mở topic khác rồi, ad xem dùm e

tronghoabg · 28/6/19

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

SA_DQ · 28/6/19

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

snow25 · 28/6/19

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

Bác Sa thức muộn vậy bác.

harukenshiro · 28/6/19

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

snow25 · 28/6/19

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

Bạn khai báo biến Public nhé.Khai báo ngoài sub.Bạn thử xem.

vanmanhvcu · 28/6/19

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?

giaiphap · 28/6/19

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

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

be_09 · 29/6/19

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

Anh có tổng kết các cách tô viềng ở bài này VBA, tô viềng trong Excel

khanhnguyen113 · 29/6/19

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

vanmanhvcu · 29/6/19

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

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

Cảm ơn bạn đã giúp đỡ
Code chạy Ok rồi.

nguyenthotnot · 1/7/19

Chào các anh chị

VetMini · 1/7/19

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.

nguyenthotnot · 1/7/19

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.

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 ý

snow25 · 1/7/19

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

Đế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é.

VetMini · 1/7/19

nguyenthotnot đã viết:
... Mình biết nó cao siêu ...

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ỹ.

luanvm123 · 2/7/19

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

snow25 · 2/7/19

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

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

iamnobika · 3/7/19

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.

luanvm123 · 3/7/19

snow25 đã viết:
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

thanks bạn

duonghychi · 8/7/19

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 đỡ ạ

snow25 · 8/7/19

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 đỡ ạ

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.

duonghychi · 8/7/19

snow25 đã viết:
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.

Xin bác chỉ cho em các khắc phục ạ.

snow25 · 8/7/19

duonghychi đã viết:
Xin bác chỉ cho em các khắc phục ạ.

Bạn đưa cái code lên thì làm sao mà chỉ chứ.Gửi File lên với yêu cầu cần viết code nữa.

duonghychi · 8/7/19

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

snow25 · 8/7/19

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

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

duonghychi · 8/7/19

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

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 ạ.

snow25 · 8/7/19

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 ạ.

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

duonghychi · 8/7/19

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,

snow25 · 8/7/19

duonghychi đã viết:
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,

Lỗi chỗ nào ta.Code mình viết dùng mảng và dictionary bạn tìm hiểu 2 cái đó là viết được.

tu205489039 · 9/7/19

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

lehuuhaint · 11/7/19

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 !

snow25 · 11/7/19

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 !

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.

lehuuhaint · 11/7/19

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.

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

VetMini · 11/7/19

Code:

With Sheet gì đó
If .Visible = xlSheetVeryHidden Then
.Visible = True
Else
.Visible = Not .Visible
End If
End With

iamnobika · 11/7/19

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.

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

iamnobika · 11/7/19

em xin lỗi quên gỡ mật khẩu, em up lại file rồi ạ.

duonghychi · 12/7/19

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!

snow25 · 12/7/19

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!

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

duonghychi · 12/7/19

snow25 đã viết:
Bạn sai ở chỗ cái code kia nó chỉ nhận 1 giá trị thôi mà.Bạn xem code.

Bác snow25 cho em xin zalo được không ạ!

MinhKhai · 14/7/19

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.

Ba Tê · 14/7/19

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.

Hình như "mà thì là" cột G sheet "TongHop" không phải Date.

MinhKhai · 15/7/19

Ba Tê đã viết:
Hình như "mà thì là" cột G sheet "TongHop" không phải Date.

Đúng như bác đã thấy là cột G không phải dạng Date. Nhưng sau khi em đổi về dạng Date mà AF vẫn không hoạt động.

batman1 · 15/7/19

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.

Bạn phạm 3 lỗi sơ đẳng.

1. Cột G không chứa ngày tháng. Nó chỉ là ngày tháng cho mắt của bạn nhưng với Excel đó là text - ngày tháng nhái.

Biến thành ngày tháng theo chuẩn Excel: chọn TongHop!G4:G10000 -> Data -> text to columns -> Next -> Next -> chọn option Date -> bên cạnh chọn DMY -> Finish

2. Không có cái gọi là "=<". Chỉ có cái gọi là "<=". Sửa Data!R3

3. Sửa thành

Mã:

Sheet3.Range("B3:J10000").AdvancedFilter 2, Sheet4.[O2:R3], Sheet4.[B3:H3]

Để như cũ bạn chỉ nhận được cột B.

MinhKhai · 15/7/19

batman1 đã viết:
Bạn phạm 3 lỗi sơ đẳng.

1. Cột G không chứa ngày tháng. Nó chỉ là ngày tháng cho mắt của bạn nhưng với Excel đó là text - ngày tháng nhái.

Biến thành ngày tháng theo chuẩn Excel: chọn TongHop!G4:G10000 -> Data -> text to columns -> Next -> Next -> chọn option Date -> bên cạnh chọn DMY -> Finish

2. Không có cái gọi là "=<". Chỉ có cái gọi là "<=". Sửa Data!R3

3. Sửa thành

Mã:

Sheet3.Range("B3:J10000").AdvancedFilter 2, Sheet4.[O2:R3], Sheet4.[B3:H3]

Để như cũ bạn chỉ nhận được cột B.

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

iamnobika · 15/7/19

Bác nào giúp em với ạ

iamnobika đã viết:
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

Bác nào giúp em với ạ !!!

HieuCD · 15/7/19

iamnobika đã viết:
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

Dùng công thức Excel

neyugngnort · 15/7/19

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ị

leonguyenz · 15/7/19

neyugngnort đã viết:
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ị

Lệnh sau:

Mã:

Selection.RowHeight = Selection.RowHeight + 2

neyugngnort · 15/7/19

leonguyenz đã viết:
Lệnh sau:

Mã:

Selection.RowHeight = Selection.RowHeight + 2

Nếu seclect 2 dòng có chiều cao khác nhau, thì lệnh k có tác dụng gì

leonguyenz · 15/7/19

neyugngnort đã viết:
Nếu seclect 2 dòng có chiều cao khác nhau, thì lệnh k có tác dụng gì

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ì?

snow25 · 15/7/19

neyugngnort đã viết:
Nếu seclect 2 dòng có chiều cao khác nhau, thì lệnh k có tác dụng gì

Vậy duyệt từng dòng mà tăng lên.

Quang_Hải · 15/7/19

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ì?

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

neyugngnort · 15/7/19

snow25 đã viết:
Vậy duyệt từng dòng mà tăng lên.

Cảm ơn bác ! chắc phải dùng vòng for chạy từng dòng. Em nghĩ thế dc không. e là tay supper chip nên có gì mấy bác chỉ giáo

iamnobika · 15/7/19

HieuCD đã viết:
Dùng công thức Excel

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 ạ?

duonghychi · 15/7/19

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.

snow25 · 15/7/19

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.

Cái total của bạn là mảng hả.Mà biến a của bạn là gì.

HieuCD · 16/7/19

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 ạ?

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.

duonghychi · 16/7/19

snow25 đã viết:
Cái total của bạn là mảng hả.Mà biến a của bạn là gì.

biến a là các gia trị trong mảng total, không biết em làm thế có đúng các không ạ?

Ba Tê · 16/7/19

duonghychi đã viết:
biến a là các gia trị trong mảng total, không biết em làm thế có đúng các không ạ?

Bạn đưa file lên và giải thích bạn muốn kết quả là gì mọi người mới hiểu được.
Code bạn viết chỉ bạn hiểu mục đích thôi.

snow25 · 16/7/19

duonghychi đã viết:
biến a là các gia trị trong mảng total, không biết em làm thế có đúng các không ạ?

A nó luôn bằng 0 mà.Bạn phải tăng nó lên chứ ví dụ.a=a+1.Mà cái gán mảng bạn cũng lỗi.

ThangCuAnh · 16/7/19

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.

duonghychi · 16/7/19

Xin các bác viết code giúp em ạ,

Ba Tê · 16/7/19

duonghychi đã viết:
Xin các bác viết code giúp em ạ,

"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.

duonghychi · 16/7/19

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.

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!

Ba Tê · 16/7/19

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!

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

duonghychi · 16/7/19

Ba Tê đã viết:
Dùng tạm cái này xem.

em cảm ơn ạ

thanhphuongvip · 18/7/19

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

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

ThangCuAnh · 18/7/19

Sorry

snow25 · 18/7/19

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

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

Câu này hả bạn hay câu nào.
Option Explicit

ThangCuAnh · 18/7/19

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)

thanhphuongvip · 18/7/19

snow25 đã viết:
Câu này hả bạn hay câu nào.
Option Explicit

Vậy cuối cùng là chỗ đó sao vậy Snow nhỉ?

batman1 · 18/7/19

thanhphuongvip đã viết:
Vậy cuối cùng là chỗ đó sao vậy Snow nhỉ?

R = .Range("C100000").End(xlUp).Row - 6 ' (A)
sArr = .Range("F7").Resize(R, Col).Value ' (B)
R = UBound(sArr) ' (C)

(A) R là số dòng có dữ liệu trên sheet tính từ dòng 7. Vd. dữ liệu tới dòng 11 thì
.Range("C100000").End(xlUp).Row trả về 11, vậy R = 11 - 6 = 5 (5 dòng dữ liệu: 7, 8, 9, 10, 11)

(B) các dòng dữ liệu trên sheet tính từ dòng 7 được nhập vào mảng sArr. Tức trên sheet có R dòng dữ liệu, và trong sArr cũng có R dòng.

(C) R bằng chỉ số trên của dòng trong mảng sArr. Do chỉ số được tính từ 1 nên R cũng chính là số dòng trong mảng sArr, mà số dòng trong sArr bằng số dòng có dữ liệu trên sheet tính từ dòng 7. Vậy R ở (C) bằng R ở (A). Chính vì thế bạn bỏ R ở (C) thì code vẫn chạy vì R đã được xác định tại (A).

R ở điểm (C) thừa nhưng nếu có thì bạn nhìn ra ngay, khỏi suy nghĩ kỹ, là mảng dArr có cùng kích thước với mảng sArr. Thế thôi.

Ở đây code ngắn nên bạn nhìn thấy ngay là R ở (C) không cần nhưng nếu code dài mà (C) nằm ở cuối thì bạn không nhìn thấy ngay được. Có R ở (C) thì dứt khoát dArr có cùng kích thước với mảng sArr.

A Đặng · 20/7/19

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 .

ThangCuAnh · 21/7/19

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...

quocturtle · 23/7/19

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

VetMini · 23/7/19

quocturtle đã viết:
Chào ace
...Cảm ơn ace

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.
...

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

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

phamdinhnha · 27/7/19

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

snow25 · 27/7/19

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

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

phamdinhnha · 28/7/19

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: 28/7/19

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: 28/7/19

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ư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 .

Ba Tê · 28/7/19

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: 28/7/19

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: 28/7/19

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 .

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.

phamdinhnha · 1/8/19

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

namtoche28 · 4/8/19

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 ạ

namtoche28 · 4/8/19

Ai giúp em bài này với ạ

lambaonguyen · 5/8/19

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

Achye · 7/8/19

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

batman1 · 7/8/19

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

Bạn dùng Sub InsertPicture của tôi trong bài #9 ở link sau

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

Có nhiều lựa chọn:
- vùng chèn ảnh là 1 cell hoặc vùng nhiều cell, hoặc nhập vào ActiveCell
- chèn ảnh kích thước thực
- chèn ảnh vừa khít vùng. Vừa khít thường không tốt. Vd. vùng chèn là hình vuông trong đó ảnh A là hình chữ nhật dài > cao, ảnh B là hình chữ nhật dài < cao. Lúc này nếu chèn vừa khít thì ảnh A và B sẽ được phóng to/thu nhỏ ở 2 chiều không như nhau nên nhìn sẽ bị "méo"
- chèn ảnh Center. Lúc này ảnh chèn luôn cân đối - 2 chiều phóng to/thu nhỏ theo cùng một tỷ lệ.
- có thể chỉ chèn link (ảnh luôn phải giữ trên đĩa. Khi mang sang máy khác phải mang ảnh theo) hoặc chèn vĩnh viễn (sau khi chèn có thể xóa ảnh trên đĩa. Khi mang sang máy khác không cần mang ảnh theo)

namtoche28 · 7/8/19

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 ạ

Không ai giúp em bài này với ạ

VetMini · 7/8/19

namtoche28 đã viết:
Không ai giúp em bài này với ạ

Ở đây là chuyên mục "giải đáp thắc mắc".
Vấn đề của bạn là nhờ làm luôn một đống code. Bạn mở riêng một thớt mà nhờ.

leviethungtoht · 14/8/19

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

quocturtle · 14/8/19

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

Bạn quên save Marco enable rồi

FPT_online · 19/8/19

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)

quocturtle · 20/8/19

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

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

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

Thành viên thường trực

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

==(^o^)==

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

==(^o^)==

File đính kèm

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

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

==(^o^)==

File đính kèm

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

Thành viên mới

/(hông là gì!

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

Thành viên mới

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

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

File đính kèm

==(^o^)==

Biên Hòa, Đồng Nai

Thành viên mới

File đính kèm

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

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

Đang đi tìm hòn đá

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

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

Đang đi tìm hòn đá

Thành viên mới

File đính kèm

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

Thành viên mới

Thành viên mới

Thành viên mới

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

Thành viên mới

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

Thành viên mới

File đính kèm

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

Thành viên mới

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

Thành viên mới

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

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

File đính kèm

Thành viên mới

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

Thành viên mới

File đính kèm

Đang đi tìm hòn đá

Thành viên mới

File đính kèm

Thành viên mới

Thành viên mới

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

Thành viên mới

Giải pháp Ếc-xào

File đính kèm

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

Giải pháp Ếc-xào

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

Giải pháp Ếc-xào

Thành viên mới

Chuyên gia GPE

File đính kèm

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

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

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

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

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

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

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

Thành viên mới

Thành viên mới

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

Chuyên gia GPE