Nhờ trợ giúp ghép chuỗi của 2 cột có điều kiện từ lớn đến nhỏ.

  • Thread starter Tú_Mỡ
  • Ngày gửi
Trạng thái
Không mở trả lời sau này.
T

Tú_Mỡ

Guest
Xin giúp đỡ code ghép chuỗi của 2 cột, cột Lớp và cột số 1, 2 và có điều kiện lấy từ cột 1, theo thứ tự giá trị trong cột và từ lớn tới nhỏ, như trong hình và như trong ô "B11". Mong mọi người giúp đỡ. Thanks mọi người nhiều nhiều.
Những vấn đề mình xin cần trợ giúp:
- Với ô trống thì không lấy giá trị đó ở cột lớp ( A,B,C.....)
- Các ô ở cột một bằng nhau thì vẫn lấy giá trị đó và giá trị có thể hoán đổi nhau cũng được không cần theo thứ tự A, B,C....khi các giá trị bằng nhau.
File trợ giúp.
Bạn cần đăng nhập để thấy hình ảnh
 
Sửa lần cuối bởi điều hành viên:
B

bvtvba

Guest
Cho cái hình thì dễ hiểu rồi, nhưng nên cho thêm cái file để mọi người khỏi phải tự gõ dữ liệu test code, bạn có nghĩ thế không?
Ô trống thì không làm việc đúng không bạn.
Ngoài ra. nếu có hai ô có giá trị bằng nhau thì sắp xếp theo thứ tự nào, chưa thấy đề bài đề cập.
 
T

Tú_Mỡ

Guest
Cho cái hình thì dễ hiểu rồi, nhưng nên cho thêm cái file để mọi người khỏi phải tự gõ dữ liệu test code, bạn có nghĩ thế không?
Ô trống thì không làm việc đúng không bạn.
Ngoài ra. nếu có hai ô có giá trị bằng nhau thì sắp xếp theo thứ tự nào, chưa thấy đề bài đề cập.

+Trước tiên xin cảm ơn bvtvba nhe
Mình có đăng lại file trên đây cần trợ giúp và những vấn đề mình xin cần trợ giúp:
- Với ô trống thì không lấy giá trị đó ở cột A,B,C.....
- Các ô ở cột một bằng nhau thì vẫn lấy giá trị đó và giá trị có thể hoán đổi nhau cũng được không cần theo thứ tự A, B,C....khi các giá trị bằng nhau.
 
B

bvtvba

Guest
Mã:
Private Type tuhocvba
    so      As Long
    kytu    As String
    
End Type
Function sapxeplondennho(ByVal vungkytu As String, ByVal vunggiatri As String) As String
    Dim arr As Variant
    Dim crr As Variant
    Dim i   As Long
    Dim j   As Long
    Dim cnt As Long
    
    Dim brr() As tuhocvba
    Dim temp  As tuhocvba
    
    Dim ketqua As String
    
    
    sapxeplondennho = ""
    arr = Range(vunggiatri).Value ' so 1,2,3
    crr = Range(vungkytu).Value 'ky tu A,B,C
    cnt = 0
    For i = LBound(arr, 1) To UBound(arr, 1) Step 1
        If CStr(arr(i, 1)) <> "" Then   'Neu khac rong thi lam viec
            If IsNumeric(CStr(arr(i, 1))) = True Then   'neu ky tu trong cell la so thi lam viec
                cnt = cnt + 1
                ReDim Preserve brr(1 To cnt)
                brr(cnt).so = CLng(arr(i, 1))
                brr(cnt).kytu = CStr(crr(i, 1))
            End If
        End If
    Next i
    If cnt = 0 Then Exit Function
    For i = LBound(brr, 1) To UBound(brr, 1) - 1 Step 1
        For j = i + 1 To UBound(brr, 1) Step 1
            If brr(i).so < brr(j).so Then
                temp = brr(i)
                brr(i) = brr(j)
                brr(j) = temp
            End If
        Next j
    Next i
    ketqua = ""
    For i = LBound(brr, 1) To UBound(brr, 1) Step 1
        ketqua = ketqua & "," & brr(i).kytu             ' ,A,B,C
    Next i
    sapxeplondennho = Right(ketqua, Len(ketqua) - 1)    'A,B,C
End Function
Bạn cần đăng nhập để thấy hình ảnh
 

tuhocvba

Administrator
Thành viên BQT
Sửa lại một chút để đầu vào là Range thì hay hơn.
Mã:
Option Explicit
Private Type tuhocvba
    so      As Long
    kytu    As String
    
End Type
Function sapxeplondennho(ByVal vungkytu As Range, ByVal vunggiatri As Range) As String
    Dim arr As Variant
    Dim crr As Variant
    Dim i   As Long
    Dim j   As Long
    Dim cnt As Long
    
    Dim brr() As tuhocvba
    Dim temp  As tuhocvba
    
    Dim ketqua As String
    
    
    sapxeplondennho = ""
    arr = vunggiatri.Value ' so 1,2,3
    crr = vungkytu.Value 'ky tu A,B,C
    cnt = 0
    For i = LBound(arr, 1) To UBound(arr, 1) Step 1
        If CStr(arr(i, 1)) <> "" Then   'Neu khac rong thi lam viec
            If IsNumeric(CStr(arr(i, 1))) = True Then   'neu ky tu trong cell la so thi lam viec
                cnt = cnt + 1
                ReDim Preserve brr(1 To cnt)
                brr(cnt).so = CLng(arr(i, 1))
                brr(cnt).kytu = CStr(crr(i, 1))
            End If
        End If
    Next i
    If cnt = 0 Then Exit Function
    For i = LBound(brr, 1) To UBound(brr, 1) - 1 Step 1
        For j = i + 1 To UBound(brr, 1) Step 1
            If brr(i).so < brr(j).so Then
                temp = brr(i)
                brr(i) = brr(j)
                brr(j) = temp
            End If
        Next j
    Next i
    ketqua = ""
    For i = LBound(brr, 1) To UBound(brr, 1) Step 1
        ketqua = ketqua & "," & brr(i).kytu             ' ,A,B,C
    Next i
    sapxeplondennho = Right(ketqua, Len(ketqua) - 1)    'A,B,C
End Function
Bạn cần đăng nhập để thấy hình ảnh
 
T

Tú_Mỡ

Guest
Mã:
Private Type tuhocvba
    so      As Long
    kytu    As String
   
End Type
Function sapxeplondennho(ByVal vungkytu As String, ByVal vunggiatri As String) As String
    Dim arr As Variant
    Dim crr As Variant
    Dim i   As Long
    Dim j   As Long
    Dim cnt As Long
   
    Dim brr() As tuhocvba
    Dim temp  As tuhocvba
   
    Dim ketqua As String
   
   
    sapxeplondennho = ""
    arr = Range(vunggiatri).Value ' so 1,2,3
    crr = Range(vungkytu).Value 'ky tu A,B,C
    cnt = 0
    For i = LBound(arr, 1) To UBound(arr, 1) Step 1
        If CStr(arr(i, 1)) <> "" Then   'Neu khac rong thi lam viec
            If IsNumeric(CStr(arr(i, 1))) = True Then   'neu ky tu trong cell la so thi lam viec
                cnt = cnt + 1
                ReDim Preserve brr(1 To cnt)
                brr(cnt).so = CLng(arr(i, 1))
                brr(cnt).kytu = CStr(crr(i, 1))
            End If
        End If
    Next i
    If cnt = 0 Then Exit Function
    For i = LBound(brr, 1) To UBound(brr, 1) - 1 Step 1
        For j = i + 1 To UBound(brr, 1) Step 1
            If brr(i).so < brr(j).so Then
                temp = brr(i)
                brr(i) = brr(j)
                brr(j) = temp
            End If
        Next j
    Next i
    ketqua = ""
    For i = LBound(brr, 1) To UBound(brr, 1) Step 1
        ketqua = ketqua & "," & brr(i).kytu             ' ,A,B,C
    Next i
    sapxeplondennho = Right(ketqua, Len(ketqua) - 1)    'A,B,C
End Function
Bạn cần đăng nhập để thấy hình ảnh
Bạn bvtvba ơi nếu mình đánh số 0 vào ô cột c thì nó vẫn tìm và liệt kê giá trị cột "A": vb vẫn cho ra giá trị D vào ô C16, bvtva có thể chỉnh sửa lại điều kiện giúp mình với.Thanks bvtvba.
 
T

Tú_Mỡ

Guest
Sửa lại một chút để đầu vào là Range thì hay hơn.
Mã:
Option Explicit
Private Type tuhocvba
    so      As Long
    kytu    As String
   
End Type
Function sapxeplondennho(ByVal vungkytu As Range, ByVal vunggiatri As Range) As String
    Dim arr As Variant
    Dim crr As Variant
    Dim i   As Long
    Dim j   As Long
    Dim cnt As Long
   
    Dim brr() As tuhocvba
    Dim temp  As tuhocvba
   
    Dim ketqua As String
   
   
    sapxeplondennho = ""
    arr = vunggiatri.Value ' so 1,2,3
    crr = vungkytu.Value 'ky tu A,B,C
    cnt = 0
    For i = LBound(arr, 1) To UBound(arr, 1) Step 1
        If CStr(arr(i, 1)) <> "" Then   'Neu khac rong thi lam viec
            If IsNumeric(CStr(arr(i, 1))) = True Then   'neu ky tu trong cell la so thi lam viec
                cnt = cnt + 1
                ReDim Preserve brr(1 To cnt)
                brr(cnt).so = CLng(arr(i, 1))
                brr(cnt).kytu = CStr(crr(i, 1))
            End If
        End If
    Next i
    If cnt = 0 Then Exit Function
    For i = LBound(brr, 1) To UBound(brr, 1) - 1 Step 1
        For j = i + 1 To UBound(brr, 1) Step 1
            If brr(i).so < brr(j).so Then
                temp = brr(i)
                brr(i) = brr(j)
                brr(j) = temp
            End If
        Next j
    Next i
    ketqua = ""
    For i = LBound(brr, 1) To UBound(brr, 1) Step 1
        ketqua = ketqua & "," & brr(i).kytu             ' ,A,B,C
    Next i
    sapxeplondennho = Right(ketqua, Len(ketqua) - 1)    'A,B,C
End Function
Bạn cần đăng nhập để thấy hình ảnh
Có thể chỉnh sửa lại điều điện khi mình cho giá trị 0 vào mà nó vẫn nhận giá trị (E,F....) được không ạ.
 

tuhocvba

Administrator
Thành viên BQT
Hiện nay đang là thế còn gì nữa.
Nếu có 0 thì nó vẫn nhận C
Bạn cần đăng nhập để thấy hình ảnh


Nếu để rỗng, theo như bạn nói thì không nhập vào, chương trình làm đúng như thế.
Bạn cần đăng nhập để thấy hình ảnh
 
B

bvtvba

Guest
bvtvba Có khi nào không cần nhiều vòng lặp như bài trên mà vẫn được không ban.Vì mình thấy nếu dữ liệu nhiều sẽ chậm file.
Chậm thì phải đưa ra được dẫn chứng. Cụ thể, data như thế nào và hết bao nhiêu lâu.
Đừng có cảm tính thấy nhiều vòng lặp mà bảo chậm. Tôi không nghĩ đấy là tiêu chuẩn hay dấu hiệu để đánh giá là chậm. Nếu bạn còn đưa ra những phán đoán vô căn cứ như này, tôi đề nghị BQT khóa topic và treo nick một tháng.
 

tuhocvba

Administrator
Thành viên BQT
Đã mở khóa chủ đề, cho phép tiếp tục thảo luận sau khi ban nick hocvba và snow24.
 

giaiphapvba

Administrator
Thành viên BQT
Bạn bvtvba ơi nếu mình đánh số 0 vào ô cột c thì nó vẫn tìm và liệt kê giá trị cột "A": vb vẫn cho ra giá trị D vào ô C16, bvtva có thể chỉnh sửa lại điều kiện giúp mình với.Thanks bvtvba.
Đọc cả bài lan man như thế này không hiểu bạn muốn nói cái gì.
Cho tới thời điểm hiện tại, căn cứ vào yêu cầu ở bài viết đầu của topic này, thì tôi thấy code đã đáp ứng yêu cầu của bạn.
Bạn cần đăng nhập để thấy hình ảnh

Trường hợp bạn thay đổi hoặc bổ sung nội dung yêu cầu, đề nghị lập topic mới. Topic này tôi coi là đã hỗ trợ đầy đủ.
 
Trạng thái
Không mở trả lời sau này.
Top