Chuyên mục xử lý, gỡ rối code VBA (4 người xem)

ndu96081631 · 24/9/13

Topic Những câu hỏi về code, xin giải thích các code... đã quá dài nên mình đóng nó lại và mở topic khác
Tất cả những bài viết liên quan đến việc nhờ giải thích, xử lý và gỡ rối code VBA, các bạn vui lòng đăng tại đây!
Cảm ơn

huuthang_bd · 21/9/17

tuananhthi đã viết:
Anh ơi có lẽ em giải thích anh lại hiểu sai ý em ý em là các ký tự ở ô ở cột A em sẽ phải tách ra làm 2 ký tự
ví dụ A2 sẽ là AA , BB và so sánh với giá trị cột F
A3 sẽ là BB,CC,DD
A4 sẽ là 1A,B3,D8,K9
từ đó dựa vào các điều kiện trong các ô tương ứng để tính ra giá trị trong các ô E2 , E3 , E4 ....

Thì tôi làm vậy. Sai chỗ nào? Chú ý đọc kỹ hướng dẫn của tôi, chỗ nào cần nhấn tôi cũng đã nhấn rồi.

huuthang_bd · 21/9/17

tuananhthi đã viết:
Anh ơi có lẽ em giải thích anh lại hiểu sai ý em ý em là các ký tự ở ô ở cột A em sẽ phải tách ra làm 2 ký tự
ví dụ A2 sẽ là AA , BB và so sánh với giá trị cột F
A3 sẽ là BB,CC,DD
A4 sẽ là 1A,B3,D8,K9
từ đó dựa vào các điều kiện trong các ô tương ứng để tính ra giá trị trong các ô E2 , E3 , E4 ....

Có sửa lại công thức một chút.

sondaubac · 21/9/17

Nhờ các thầy và các anh em giúp đỡ, CODE trong File Excel này vướng chỗ nào mà em chạy không được.

Option Explicit

Type LoaiVatTu
MaSo As String
Ten As String
DonVi As String
KhoiLuong As Double
End Type

Public Sub DanhSachVatTu()
Dim R As Range 'Pham vi trong BANG VAT LIEU can phan tich vat tu
Dim DanhSachVT() As LoaiVatTu ' Mang dong chua danh sach vat tu
Dim i As Long ' Chi so Mang dong
Dim k As Long ' Bien nay dung de duyet bang du lieu trong R

'chon vung du lieu can tinh TONG HOP VAT TU
Set R = Application.InputBox("Chon vung du lieu can tong hop vat tu", Type:=8)

i = 0 'chi so dau tien cua Mang vat tu la 0

Dim ii As Long
Dim ok As Boolean

'Doc du lieu tu sheet "Phan tich vat tu"
For Each k In R.Columns(1).Cells 'Chay qua tung o cua cot R

If Trim(k.Value) <> "" Then ' Trim la de cat bo nhung khoang trang trong tung o du lieu
If i = 0 Then ' vat tu dau tien trong danh sach
ReDim Preserve DanhSachVT(i) 'Gan du lieu cho vat tu dau tien
DanhSachVT(i).MaSo = Trim(k.Value)
DanhSachVT(i).Ten = Trim(k.Offset(0, 1).Value)
DanhSachVT(i).DonVi = Trim(k.Offset(0, 2).Value)
DanhSachVT(i).KhoiLuong = k.Offset(0, 3).Value
i = i + 1 ' tang chi so mang len 1
Else ' Neu danh sach vat tu lon hon 1
ok = True
For ii = 0 To i - 1
'vat tu nay da co trong danh sach
If DanhSachVT(ii).MaSo = Trim(k.Value) Then
ok = False
DanhSachVT(ii).KhoiLuong = DanhSachVT(ii).KhoiLuong + k.Offset(0, 3).Value
Exit For
End If
Next ii
'vat tu chua co ten trong danh sach
If ok Then

ReDim Preserve DanhSachVT(i) 'Gan du lieu cho vat tu dau tien
DanhSachVT(i).MaSo = Trim(k.Value)
DanhSachVT(i).Ten = Trim(k.Offset(0, 1).Value)
DanhSachVT(i).DonVi = Trim(k.Offset(0, 2).Value)
DanhSachVT(i).KhoiLuong = k.Offset(0, 3).Value
i = i + 1
End If
End If
End If
Next
'Ghi ket qua ra Excel, trong sheet "Tong hop vat tu"
Dim j As Long
Dim row As Long

row = 1 'Bat dau ghi du lieu tu dong so 1
For j = LBound(DanhSachVT) To UBound(DanhSachVT)
ThisWorkbook.Worksheets("Tong hop vat tu").Cells(row + j, 1).Value = j + 1
ThisWorkbook.Worksheets("Tong hop vat tu").Cells(row + j, 2).Value = DanhSachVT(j).MaSo
ThisWorkbook.Worksheets("Tong hop vat tu").Cells(row + j, 3).Value = DanhSachVT(j).Ten
ThisWorkbook.Worksheets("Tong hop vat tu").Cells(row + j, 4).Value = DanhSachVT(j).DonVi
ThisWorkbook.Worksheets("Tong hop vat tu").Cells(row + j, 5).Value = DanhSachVT(j).KhoiLuong
Next j
MsgBox "Ket thuc"

End Sub

sondaubac · 21/9/17

Đây nữa, Sao em chạy thử mà không được gì cả. Rất mong được mọi người hướng dẫn thêm ạ

giaiphap · 21/9/17

sondaubac đã viết:
Đây nữa, Sao em chạy thử mà không được gì cả. Rất mong được mọi người hướng dẫn thêm ạ

Ủa sao mình lại nhập được.

sondaubac · 21/9/17

giaiphap đã viết:
Ủa sao mình lại nhập được.

Vậy chắc là lúc nãy nó bị xung đột cái gì rồi . Bạn xem luôn dùm mình cái file Phân tích vật tư ở phía trên luôn cái. Nó bị lỗi gì mà tìm không ra

sangista · 22/9/17

Chào mấy anh/chị

Cho em hỏi mình có code nào để rút ngắn lệnh trên excel không ạ.
Ví dụ như hình bên dưới, em muốn nhấn 1 lệnh là nó ra beetween luôn khỏi phải đi từng bước.

sangista · 22/9/17

Chào mấy anh/chị

Cho em hỏi, em muốn lọc autofilter ngày tháng như bên dưới, nhưng khi viết thì lúc lọc nó không ra đúng. Anh, Chị nào biết giúp em đoạn code bên dưới với.
Em cảm ơn.

Sub Locngayxuat()
Dim dDate As Date
Dim lDate As Long
If IsDate(Range("$C$8:$Q$1001")) Then
dDate = Range("$C$8:$Q$1001")
lDate = DateSerial(Year(dDate), Month(dDate), Day(dDate))
End If
Range("I6").Select
NgayBD = ActiveCell.Value
Range("K6").Select
NgayKT = ActiveCell.Value
ActiveSheet.Range("$C$8:$Q$1001").AutoFilter Field:=2, Criteria1:=">=NgayBD" & lDate, Operator:=xlAnd, Criteria2:="<=NgayKT" & lDate
End Sub

PacificPR · 22/9/17

sondaubac đã viết:
Vậy chắc là lúc nãy nó bị xung đột cái gì rồi . Bạn xem luôn dùm mình cái file Phân tích vật tư ở phía trên luôn cái. Nó bị lỗi gì mà tìm không ra

Cái Code cũ sửa lại như thế này thì chạy được

PHP:

Public Sub DanhSachVatTu()
    Dim R As Range 'Pham vi trong BANG VAT LIEU can phan tich vat tu
    Dim DanhSachVT() As LoaiVatTu  ' Mang dong chua danh sach vat tu
    Dim I As Long  ' Chi so Mang dong
    Dim K As Range  ' Bien nay dung de duyet bang du lieu trong R
    'chon vung du lieu can tinh TONG HOP VAT TU
    Set R = Application.InputBox("Chon vung du lieu can tong hop vat tu", Type:=8)
    I = 0 'chi so dau tien cua Mang vat tu la 0
    Dim ii As Long
    Dim ok As Boolean
    'Doc du lieu tu sheet "Phan tich vat tu"
    For Each K In R.Columns(1).Cells           'Chay qua tung o cua cot R
        If Trim(K.Value) <> "" Then   ' Trim la de cat bo nhung khoang trang trong tung o du lieu
            If I = 0 Then ' vat tu dau tien trong danh sach
                ReDim Preserve DanhSachVT(I) 'Gan du lieu cho vat tu dau tien
                DanhSachVT(I).MaSo = Trim(K.Value)
                DanhSachVT(I).Ten = Trim(K.Offset(0, 1).Value)
                DanhSachVT(I).DonVi = Trim(K.Offset(0, 2).Value)
                DanhSachVT(I).KhoiLuong = K.Offset(0, 3).Value
                I = I + 1      ' tang chi so mang len 1
                Else  ' Neu danh sach vat tu lon hon 1
                ok = True
                For ii = 0 To I - 1
                    'vat tu nay da co trong danh sach
                    If DanhSachVT(ii).MaSo = Trim(K.Value) Then
                        ok = False
                        DanhSachVT(ii).KhoiLuong = DanhSachVT(ii).KhoiLuong + K.Offset(0, 3).Value
                        Exit For
                    End If
                Next ii
                'vat tu chua co ten trong danh sach
                If ok Then
                    ReDim Preserve DanhSachVT(I) 'Gan du lieu cho vat tu dau tien
                    DanhSachVT(I).MaSo = Trim(K.Value)
                    DanhSachVT(I).Ten = Trim(K.Offset(0, 1).Value)
                    DanhSachVT(I).DonVi = Trim(K.Offset(0, 2).Value)
                    DanhSachVT(I).KhoiLuong = K.Offset(0, 3).Value
                    I = I + 1
                End If
            End If
        End If
    Next
    'Ghi ket qua ra Excel, trong sheet "Tong hop vat tu"
    Dim J As Long
    Dim row As Long
    row = 3 'Bat dau ghi du lieu tu dong so 1
    For J = LBound(DanhSachVT) To UBound(DanhSachVT)
        Sheet2.Cells(row + J, 1).Value = J + 1
        Sheet2.Cells(row + J, 2).Value = DanhSachVT(J).MaSo
        Sheet2.Cells(row + J, 3).Value = DanhSachVT(J).Ten
        Sheet2.Cells(row + J, 4).Value = DanhSachVT(J).DonVi
        Sheet2.Cells(row + J, 5).Value = DanhSachVT(J).KhoiLuong
    Next J
    MsgBox "Ket thuc"
End Sub

Em góp vui với cái Phân tích vật tư

sondaubac · 22/9/17

Ôi hay quá Pacific ơi, qua chủ đề này giúp mình với
http://www.giaiphapexcel.com/diendan/threads/nhờ-giúp-em-viết-code-vba-tính-cột-thành-tiền-và-link-đơn-giá.129787/page-3
à mà bạn có thể cho mình hỏi thêm chỗ này được không?
Trong cái CODE Tổng hợp vật tư mà bạn góp vui thì nhờ bạn giải thích hộ với, mình còn non nớt quá ...

1/ Phần số 1:
[ php] Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("Phan tich vat tu")
sArr = .Range(.[C6], .[C65536].End(xlUp)).Resize(, 4).Value
End With [/php ]

2/ Phần số 2:
ReDim dArr(1 To UBound(sArr, 1), 1 To 4)

3/ Phần số 3:
For I = 1 To UBound(sArr, 1)
If sArr(I, 1) <> Empty Then
Tem = sArr(I, 1)
If Not Dic.Exists(Tem) Then
K = K + 1
Dic.Add Tem, K
dArr(K, 1) = Tem: dArr(K, 2) = sArr(I, 2)
dArr(K, 3) = sArr(I, 3): dArr(K, 4) = sArr(I, 4)
Else
dArr(Dic.Item(Tem), 4) = dArr(Dic.Item(Tem), 4) + sArr(I, 4)
End If
End If
Next I

tuananhthi · 22/9/17

huuthang_bd đã viết:
Có sửa lại công thức một chút.

Em cảm ơn anh lắm lắm, anh quá là pro luôn

huuthang_bd · 22/9/17

tuananhthi đã viết:
Em cảm ơn anh lắm lắm, anh quá là pro luôn

Trường hợp của bạn thì đoán ý bạn khó hơn việc giải quyết vấn đề.
Ví dụ:

1. Vba loại bỏ các trường hợp trùng sau đó và bắt đầu ghi vào dòng thứ 3 cột K (như trong ví dụ sẽ là 1A - 1B - 1D - 1E - 2C - 2E vào các dòng liên tiếp của cột K)

Nói như thế này thì ai cũng hiểu: Lọc duy nhất cột C sau đó sắp xếp lại và ghi kết quả vào cột K, bắt đầu từ K3.

tuananhthi · 22/9/17

huuthang_bd đã viết:
Trường hợp của bạn thì đoán ý bạn khó hơn việc giải quyết vấn đề.
Ví dụ:

Nói như thế này thì ai cũng hiểu: Lọc duy nhất cột C sau đó sắp xếp lại và ghi kết quả vào cột K, bắt đầu từ K3.

Dạ, em dùng từ ngữ còn rối quá

Em còn một mong muốn nữa, mong anh giải thích dùm em cái công thức của anh cho nó chọn vẹn ạ

=(SUM(LARGE(COUNTIF($F$2:$F$10,MID(A2,ROW($A$1:$A$4)*2-1,2)),ROW($A$1:$A$4))*IF(--RIGHT(D2)<4,(ROW($A$1:$A$4)=RIGHT(D2)+1)*RIGHT(D2),{0;1;4;3}))

Em chưa hiểu hết logic trong đó, nên mới thắc mắc tại sao lại lấy giá trị MID(A2,ROW($A$1:$A$4)*2-1,2 )hay các số đằng sau nó {0;1;4;3} và nếu thằng D nó ko phải các giá trị x1,x2,x3,x4,x5 mà là bút,vở,sách,bảng thì sẽ thế nào

) sẽ phải if nó bằng luôn giá trị đó là đc hay phải viết 1 công thức mới. Em cảm ơn anh Thắng nhiều !

huuthang_bd · 22/9/17

tuananhthi đã viết:
Dạ, em dùng từ ngữ còn rối quá Em còn một mong muốn nữa, mong anh giải thích dùm em cái công thức của anh cho nó chọn vẹn ạ

=(SUM(LARGE(COUNTIF($F$2:$F$10,MID(A2,ROW($A$1:$A$4)*2-1,2)),ROW($A$1:$A$4))*IF(--RIGHT(D2)<4,(ROW($A$1:$A$4)=RIGHT(D2)+1)*RIGHT(D2),{0;1;4;3}))

Em chưa hiểu hết logic trong đó, nên mới thắc mắc tại sao lại lấy giá trị MID(A2,ROW($A$1:$A$4)*2-1,2 )hay các số đằng sau nó {0;1;4;3} và

Giải thích thì tôi... thua. Cái này tôi nhờ bạn tôi làm giùm đó

tuananhthi đã viết:
nếu thằng D nó ko phải các giá trị x1,x2,x3,x4,x5 mà là bút,vở,sách,bảng thì sẽ thế nào ) sẽ phải if nó bằng luôn giá trị đó là đc hay phải viết 1 công thức mới. Em cảm ơn anh Thắng nhiều !

Thay --RIGHT(D2) và RIGHT(D2) thành

Mã:

MATCH(D2,{"Bút","Vở","Sách","Bảng","Thước"})

tuananhthi · 22/9/17

huuthang_bd đã viết:
Giải thích thì tôi... thua. Cái này tôi nhờ bạn tôi làm giùm đó

Thay --RIGHT(D2) và RIGHT(D2) thành

Mã:

MATCH(D2,{"Bút","Vở","Sách","Bảng","Thước"})

Em cảm ơn anh

sondaubac · 22/9/17

Em muốn khai báo và chọn mảng từ ô A1 đến ô A1000. Nhờ các cao thủ giải thích cho em với, em bị lỗi gì

Mã:

Sub Mang_Arr1()
    Dim SArr()
    SArr = Range([A6], [A1000]).Select
End Sub

sondaubac · 22/9/17

Mã:

Sub Mang_sArr()
    Dim Dic As Object
    Dim sArr(), dArr
    Set Dic = CreateObject("Scripting.Dictionary")
        
    With Sheet1
        
        sArr = .range(.[a6],.[a1000]).End(xlUp)).Resize(,4).value
        
    End With
    
    ReDim dArr(1 To UBound(sArr, 1), 1 To 4)
    
    
End Sub

CODE này cũng bị lỗi chỗ nào nhờ các cao thủ chỉ giáo, em xin cảm ơn

huuthang_bd · 22/9/17

sondaubac đã viết:
Mã:

Sub Mang_sArr() Dim Dic As Object Dim sArr(), dArr Set Dic = CreateObject("Scripting.Dictionary") With Sheet1 sArr = .range(.[a6],.[a1000]).End(xlUp)).Resize(,4).value End With ReDim dArr(1 To UBound(sArr, 1), 1 To 4) End Sub

CODE này cũng bị lỗi chỗ nào nhờ các cao thủ chỉ giáo, em xin cảm ơn

Dư dấu đóng ngoặc sau [a1000]

sondaubac · 22/9/17

huuthang_bd đã viết:
Dư dấu đóng ngoặc sau [a1000]

Vậy sau dòng này có nghĩa là gì vậy anh?

Mã:

sArr = .Range(.[C6], .[C65536].End(xlUp)).Resize(, 4).Value

nếu em chuyển thành như thế này thì bị lỗi vì sao?

Mã:

sArr = .Range(.[C6], .[C65536].End(xlUp)).Resize(, 4).select

như thế này nữa

Mã:

sArr = .Range(.[C6], .[C65536].End(xlUp)).select

huuthang_bd · 22/9/17

sondaubac đã viết:
Vậy sau dòng này có nghĩa là gì vậy anh?

Mã:

sArr = .Range(.[C6], .[C65536].End(xlUp)).Resize(, 4).Value

.[C65536].End(xlUp) tương đương với ô mà khi chọn ô C65536 rồi nhấn Ctrl và phím mũi tên lên.

sondaubac đã viết:
nếu em chuyển thành như thế này thì bị lỗi vì sao?

Mã:

sArr = .Range(.[C6], .[C65536].End(xlUp)).Resize(, 4).select

như thế này nữa

Mã:

sArr = .Range(.[C6], .[C65536].End(xlUp)).select

Select là phương thức (chọn), không trả về giá trị nên bị lỗi khi gán cho biến sArr.

Chuyên mục xử lý, gỡ rối code VBA (4 người xem)

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

Huyền thoại GPE

Chuyên gia GPE

Chuyên gia GPE

File đính kèm

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

File đính kèm

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

File đính kèm

==(^o^)==

File đính kèm

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

Thành viên mới

Thành viên mới

File đính kèm

Thành viên mới

File đính kèm

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

Thành viên mới

Chuyên gia GPE

Thành viên mới

Chuyên gia GPE

Thành viên mới

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

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

File đính kèm

Chuyên gia GPE

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

Chuyên gia GPE

Đếm ngược thời gian