Mong các bạn giúp mình thu gọn liệt kê (1 người xem)

  • Thread starter Thread starter khoa186
  • Ngày gửi Ngày gửi
Liên hệ QC

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

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

khoa186

Thành viên chính thức
Tham gia
23/11/07
Bài viết
64
Được thích
4
Mong các anh chị em giúp đỡ , mình có 1 bảng phân công giáo viên thế này , mình mong muốn nó rút gọn lại giống như file đính kèm , mong các bạn giúp đỡ , cảm ơn các bạn
HỌ TÊNTHỰC TẾMONG MUỐN
Lâm Kiều Trinh6A12,7A1,7A2,7A3,7A4,7A5,7A6,7A11,7A12,7A13,7A14,7A15,7A16,9A3,9A6,9A7,9A8,9A9,9A10,9A11,9A12,9A13,9A14,9A15,9A166A12,7A1-->7A6,7A11-->7A16,9A3,9A6-->9A16
Lương Thị Thanh Thủy8A1,8A2,8A3,8A4,8A5,8A6,8A7,8A8,8A9,8A10,8A11,8A12,8A13,8A14,8A15,8A16,9A1,9A2,9A3,9A4,9A58A1-->8A16,9A1-->9A5
Nguyễn Thu Thủy6A1,6A2,6A3,6A4,6A5,6A6,6A7,6A8,6A9,6A10,6A11,6A12,6A13,6A14,6A15,6A16,6A17,7A7,7A8,7A9,7A106A1-->6A17,7A7-->7A10
 

File đính kèm

up, mong các bạn có thể giúp mình
 
khoa186 đã viết:
Mong các anh chị em giúp đỡ , mình có 1 bảng phân công giáo viên thế này , mình mong muốn nó rút gọn lại giống như file đính kèm , mong các bạn giúp đỡ , cảm ơn các bạn
HỌ TÊNTHỰC TẾMONG MUỐN
Lâm Kiều Trinh6A12,7A1,7A2,7A3,7A4,7A5,7A6,7A11,7A12,7A13,7A14,7A15,7A16,9A3,9A6,9A7,9A8,9A9,9A10,9A11,9A12,9A13,9A14,9A15,9A166A12,7A1-->7A6,7A11-->7A16,9A3,9A6-->9A16
Lương Thị Thanh Thủy8A1,8A2,8A3,8A4,8A5,8A6,8A7,8A8,8A9,8A10,8A11,8A12,8A13,8A14,8A15,8A16,9A1,9A2,9A3,9A4,9A58A1-->8A16,9A1-->9A5
Nguyễn Thu Thủy6A1,6A2,6A3,6A4,6A5,6A6,6A7,6A8,6A9,6A10,6A11,6A12,6A13,6A14,6A15,6A16,6A17,7A7,7A8,7A9,7A106A1-->6A17,7A7-->7A10
Nhấp chuột vào đây để mở rộng...

Dùng hàm tự tạo
Mã: 
Function GopLop(ByVal iStr As String) As String
  Dim Arr(), Stt(), S, Res$
  Dim tmp$, iKey$, sN&, n&, L&, i&, j&
 
  If iStr = Empty Then Exit Function
  ReDim Arr(1 To 100, 1 To 2)
  S = Split(iStr, ",")
  With CreateObject("scripting.dictionary")
    For n = 0 To UBound(S)
      tmp = S(n)
      L = Len(tmp)
      For j = L To 1 Step -1
        If IsNumeric(Mid(tmp, j, 1)) = False Then
          iKey = Mid(tmp, 1, j)
          If .exists(iKey) = False Then
            k = k + 1
            .Add iKey, k
            Arr(k, 1) = iKey
            Arr(k, 2) = "," & Replace(tmp, iKey, "")
          Else
            ik = .Item(iKey)
            Arr(ik, 2) = Arr(ik, 2) & "," & Replace(tmp, iKey, "")
          End If
          Exit For
        End If
      Next j
    Next n
  End With
 
  For i = 1 To k
    tmp = Arr(i, 1)
    ReDim Stt(0 To 100)
    S = Split(Arr(i, 2), ",")
    For j = 1 To UBound(S)
      Stt(CLng(S(j))) = "1"
    Next j
    For j = 1 To 99
      If Stt(j) = "1" Then
        If Stt(j - 1) = Empty Then
          Res = Res & "," & tmp & j
        End If
        If Stt(j + 1) = Empty Then
          If Stt(j - 1) = "1" Then
            Res = Res & "-->" & tmp & j
          End If
        End If
      End If
    Next j
  Next i
  GopLop = Mid(Res, 2, Len(Res))
End Function
 

File đính kèm

ôi dã man quá , cảm ơn bạn rất rất nhiều
Bài đã được tự động gộp:

GIỜ VẪN CHƯA HẾT PHÊ , CÁC BẠN GIỎI THẬT
 
Lần chỉnh sửa cuối:
HieuCD đã viết:
Dùng hàm tự tạo
Mã: 
Function GopLop(ByVal iStr As String) As String
  Dim Arr(), Stt(), S, Res$
  Dim tmp$, iKey$, sN&, n&, L&, i&, j&

  If iStr = Empty Then Exit Function
  ReDim Arr(1 To 100, 1 To 2)
  S = Split(iStr, ",")
  With CreateObject("scripting.dictionary")
    For n = 0 To UBound(S)
      tmp = S(n)
      L = Len(tmp)
      For j = L To 1 Step -1
        If IsNumeric(Mid(tmp, j, 1)) = False Then
          iKey = Mid(tmp, 1, j)
          If .exists(iKey) = False Then
            k = k + 1
            .Add iKey, k
            Arr(k, 1) = iKey
            Arr(k, 2) = "," & Replace(tmp, iKey, "")
          Else
            ik = .Item(iKey)
            Arr(ik, 2) = Arr(ik, 2) & "," & Replace(tmp, iKey, "")
          End If
          Exit For
        End If
      Next j
    Next n
  End With

  For i = 1 To k
    tmp = Arr(i, 1)
    ReDim Stt(0 To 100)
    S = Split(Arr(i, 2), ",")
    For j = 1 To UBound(S)
      Stt(CLng(S(j))) = "1"
    Next j
    For j = 1 To 99
      If Stt(j) = "1" Then
        If Stt(j - 1) = Empty Then
          Res = Res & "," & tmp & j
        End If
        If Stt(j + 1) = Empty Then
          If Stt(j - 1) = "1" Then
            Res = Res & "-->" & tmp & j
          End If
        End If
      End If
    Next j
  Next i
  GopLop = Mid(Res, 2, Len(Res))
End Function
Nhấp chuột vào đây để mở rộng...
đầu tiên cảm ơn bạn đã giúp mình , nhưng bạn có thể giúp mình sửa lại chút là ví dụ 2 lớp xen kẽ nhau , ví dụ 6a1,6a2 không cần phải hiện 6a1-->6a2 , trên 3 lớp kế nhau thì mới hiện --> , mình cảm ơn rất nhiều
 
khoa186 đã viết:
Mong các anh chị em giúp đỡ , mình có 1 bảng phân công giáo viên thế này , mình mong muốn nó rút gọn lại giống như file đính kèm , mong các bạn giúp đỡ , cảm ơn các bạn
HỌ TÊNTHỰC TẾMONG MUỐN
Lâm Kiều Trinh6A12,7A1,7A2,7A3,7A4,7A5,7A6,7A11,7A12,7A13,7A14,7A15,7A16,9A3,9A6,9A7,9A8,9A9,9A10,9A11,9A12,9A13,9A14,9A15,9A166A12,7A1-->7A6,7A11-->7A16,9A3,9A6-->9A16
Lương Thị Thanh Thủy8A1,8A2,8A3,8A4,8A5,8A6,8A7,8A8,8A9,8A10,8A11,8A12,8A13,8A14,8A15,8A16,9A1,9A2,9A3,9A4,9A58A1-->8A16,9A1-->9A5
Nguyễn Thu Thủy6A1,6A2,6A3,6A4,6A5,6A6,6A7,6A8,6A9,6A10,6A11,6A12,6A13,6A14,6A15,6A16,6A17,7A7,7A8,7A9,7A106A1-->6A17,7A7-->7A10
Nhấp chuột vào đây để mở rộng...
Cho bạn thêm cách khác với chuỗi phải xếp theo thứ tự tăng dần
Mã: 
Function cnrN(ByVal str As String, Optional ByVal n As Long = 1)
With CreateObject("vbscript.regexp")
    .Global = True
    If n = 1 Then
        .Pattern = "(\d+)([A-Z])(\d+)"
        cnrN = Val(.Execute(str)(0).SubMatches(0) & AscW(.Execute(str)(0).SubMatches(1)) & Format(.Execute(str)(0).SubMatches(2), "00"))
    Else
        .Pattern = "\,{2,}"
         cnrN = .Replace(str, "-->")
    End If
End With
End Function
Function SStr(ByVal str As String) As String
Dim i As Long, arrN, arrR
arrSTR = Split(str, ",")
ReDim arrR(0 To UBound(arrSTR))
arrR(0) = arrSTR(0): arrR(UBound(arrSTR)) = arrSTR(UBound(arrSTR))
For i = 1 To UBound(arrSTR) - 1
    If Not (cnrN(arrSTR(i)) = cnrN(arrSTR(i - 1)) + 1 And cnrN(arrSTR(i)) = cnrN(arrSTR(i + 1)) - 1) Then arrR(i) = arrSTR(i)
Next
SStr = cnrN(Join(arrR, ","), 2)
End Function
CÔng thức: =SStr(B2)
 
Lần chỉnh sửa cuối:
khoa186 đã viết:
đầu tiên cảm ơn bạn đã giúp mình , nhưng bạn có thể giúp mình sửa lại chút là ví dụ 2 lớp xen kẽ nhau , ví dụ 6a1,6a2 không cần phải hiện 6a1-->6a2 , trên 3 lớp kế nhau thì mới hiện --> , mình cảm ơn rất nhiều
Nhấp chuột vào đây để mở rộng...
Chỉnh lại
Mã: 
Function GopLop(ByVal iStr As String) As String
  Dim Arr(), Stt(), S, Res$
  Dim tmp$, iKey$, sN&, n&, L&, i&, j&
 
  If iStr = Empty Then Exit Function
  ReDim Arr(1 To 100, 1 To 2)
  S = Split(iStr, ",")
  With CreateObject("scripting.dictionary")
    For n = 0 To UBound(S)
      tmp = S(n)
      L = Len(tmp)
      For j = L To 1 Step -1
        If IsNumeric(Mid(tmp, j, 1)) = False Then
          iKey = Mid(tmp, 1, j)
          If .exists(iKey) = False Then
            k = k + 1
            .Add iKey, k
            Arr(k, 1) = iKey
            Arr(k, 2) = "," & Replace(tmp, iKey, "")
          Else
            ik = .Item(iKey)
            Arr(ik, 2) = Arr(ik, 2) & "," & Replace(tmp, iKey, "")
          End If
          Exit For
        End If
      Next j
    Next n
  End With
 
  For i = 1 To k
    tmp = Arr(i, 1)
    ReDim Stt(-1 To 100)
    S = Split(Arr(i, 2), ",")
    For j = 1 To UBound(S)
      Stt(CLng(S(j))) = "1"
    Next j
    For j = 1 To 99
      If Stt(j) = "1" Then
        If Stt(j - 1) = Empty Then
          Res = Res & "," & tmp & j
        End If
        If Stt(j + 1) = Empty Then
          If Stt(j - 1) = "1" Then
            If Stt(j - 2) = Empty Then
              Res = Res & "," & tmp & j
            Else
              Res = Res & "-->" & tmp & j
            End If
          End If
        End If
      End If
    Next j
  Next i
  GopLop = Mid(Res, 2, Len(Res))
End Function
Bài đã được tự động gộp:

excel_lv1.5 đã viết:
Cho bạn thêm cách khác:
Mã: 
Function cnrN(ByVal str As String, Optional ByVal n As Long = 1)
With CreateObject("vbscript.regexp")
    .Global = True
    If n = 1 Then
        .Pattern = "(\d+)([A-Z])(\d+)"
        cnrN = Val(.Execute(str)(0).SubMatches(0) & AscW(.Execute(str)(0).SubMatches(1)) & Format(.Execute(str)(0).SubMatches(2), "00"))
    Else
        .Pattern = "\,{2,}"
         cnrN = .Replace(str, "-->")
    End If
End With
End Function
Function SStr(ByVal str As String) As String
Dim i As Long, arrN, arrR
arrSTR = Split(str, ",")
ReDim arrR(0 To UBound(arrSTR))
arrR(0) = arrSTR(0): arrR(UBound(arrSTR)) = arrSTR(UBound(arrSTR))
For i = 1 To UBound(arrSTR) - 1
    If Not (cnrN(arrSTR(i)) = cnrN(arrSTR(i - 1)) + 1 And cnrN(arrSTR(i)) = cnrN(arrSTR(i + 1)) - 1) Then arrR(i) = arrSTR(i)
Next
SStr = cnrN(Join(arrR, ","), 2)
End Function
CÔng thức: =SStr(B2)
Nhấp chuột vào đây để mở rộng...
Nếu chưa xếp thứ tự, kết quả sẽ lệch, ví dụ: 6A11,6A12,7A1,7A3,7A2,6A13
kết quả sẽ là: 6A11,6A12,7A1,7A3,7A2,6A13
 
Lần chỉnh sửa cuối:
HieuCD đã viết:
Chỉnh lại
Mã: 
Function GopLop(ByVal iStr As String) As String
  Dim Arr(), Stt(), S, Res$
  Dim tmp$, iKey$, sN&, n&, L&, i&, j&

  If iStr = Empty Then Exit Function
  ReDim Arr(1 To 100, 1 To 2)
  S = Split(iStr, ",")
  With CreateObject("scripting.dictionary")
    For n = 0 To UBound(S)
      tmp = S(n)
      L = Len(tmp)
      For j = L To 1 Step -1
        If IsNumeric(Mid(tmp, j, 1)) = False Then
          iKey = Mid(tmp, 1, j)
          If .exists(iKey) = False Then
            k = k + 1
            .Add iKey, k
            Arr(k, 1) = iKey
            Arr(k, 2) = "," & Replace(tmp, iKey, "")
          Else
            ik = .Item(iKey)
            Arr(ik, 2) = Arr(ik, 2) & "," & Replace(tmp, iKey, "")
          End If
          Exit For
        End If
      Next j
    Next n
  End With

  For i = 1 To k
    tmp = Arr(i, 1)
    ReDim Stt(-1 To 100)
    S = Split(Arr(i, 2), ",")
    For j = 1 To UBound(S)
      Stt(CLng(S(j))) = "1"
    Next j
    For j = 1 To 99
      If Stt(j) = "1" Then
        If Stt(j - 1) = Empty Then
          Res = Res & "," & tmp & j
        End If
        If Stt(j + 1) = Empty Then
          If Stt(j - 1) = "1" Then
            If Stt(j - 2) = Empty Then
              Res = Res & "," & tmp & j
            Else
              Res = Res & "-->" & tmp & j
            End If
          End If
        End If
      End If
    Next j
  Next i
  GopLop = Mid(Res, 2, Len(Res))
End Function
Bài đã được tự động gộp:


Nếu chưa xếp thứ tự, kết quả sẽ lệch, ví dụ: 6A11,6A12,7A1,7A3,7A2,6A13
kết quả sẽ là: 6A11,6A12,7A1,7A3,7A2,6A13
Nhấp chuột vào đây để mở rộng...
Tôi quên ghi chú, chuỗi phải xếp theo thứ tự tăng dần:).
 
HieuCD đã viết:
Chỉnh lại
Mã: 
Function GopLop(ByVal iStr As String) As String
  Dim Arr(), Stt(), S, Res$
  Dim tmp$, iKey$, sN&, n&, L&, i&, j&

  If iStr = Empty Then Exit Function
  ReDim Arr(1 To 100, 1 To 2)
  S = Split(iStr, ",")
  With CreateObject("scripting.dictionary")
    For n = 0 To UBound(S)
      tmp = S(n)
      L = Len(tmp)
      For j = L To 1 Step -1
        If IsNumeric(Mid(tmp, j, 1)) = False Then
          iKey = Mid(tmp, 1, j)
          If .exists(iKey) = False Then
            k = k + 1
            .Add iKey, k
            Arr(k, 1) = iKey
            Arr(k, 2) = "," & Replace(tmp, iKey, "")
          Else
            ik = .Item(iKey)
            Arr(ik, 2) = Arr(ik, 2) & "," & Replace(tmp, iKey, "")
          End If
          Exit For
        End If
      Next j
    Next n
  End With

  For i = 1 To k
    tmp = Arr(i, 1)
    ReDim Stt(-1 To 100)
    S = Split(Arr(i, 2), ",")
    For j = 1 To UBound(S)
      Stt(CLng(S(j))) = "1"
    Next j
    For j = 1 To 99
      If Stt(j) = "1" Then
        If Stt(j - 1) = Empty Then
          Res = Res & "," & tmp & j
        End If
        If Stt(j + 1) = Empty Then
          If Stt(j - 1) = "1" Then
            If Stt(j - 2) = Empty Then
              Res = Res & "," & tmp & j
            Else
              Res = Res & "-->" & tmp & j
            End If
          End If
        End If
      End If
    Next j
  Next i
  GopLop = Mid(Res, 2, Len(Res))
End Function
Bài đã được tự động gộp:


Nếu chưa xếp thứ tự, kết quả sẽ lệch, ví dụ: 6A11,6A12,7A1,7A3,7A2,6A13
kết quả sẽ là: 6A11,6A12,7A1,7A3,7A2,6A13
Nhấp chuột vào đây để mở rộng...
đầu tiên xin cảm ơn bác , mong bác giúp mình 1 vấn đề này nữa nha .Giờ em lại lòi thêm 1 việc nữa là bắt tách ra theo từng khối lớp ví dụ . Cô uyên khối 6 từ 6a7 đến 6a9 (chỉ cần ghi số lớp phía sau 7-->9), khối 7 không có , khối 8 có 8a8 thì điền số 8 phía sau chữ a , khối 9 thì có 2 lớp 9a2,9a8 thì điền 2,8 . Một lần nữa xin cảm ơn bác
Họ và tênMôn dạyLớp dạy được phân côngKHỐI 6KHỐI 7KHỐI 8KHỐI 9
Trần Thị Đỗ UyênVăn6a7,6a8,6a9,8A8,9A2,9A87-->982,8
Nguyễn Trọng Ngọc Minh TrangVăn8A2,9A3,9A1523,15
Phạm Thị Phượng Văn6A13,6A14,8A6,8A913,146,9
Nguyễn Thị Xuân DungVăn7A4,7A13,8A10,8A154,1310,15
Trần Thị Mỹ DuyênVăn6A6,9A6,9A966,9
Tôn Nữ Nhật HằngVăn6A3,6A7,7A33,73
Nguyễn Thị Bích HạnhVăn8A4,8A5,9A7,9A134,57,13
 

File đính kèm

khoa186 đã viết:
đầu tiên xin cảm ơn bác , mong bác giúp mình 1 vấn đề này nữa nha .Giờ em lại lòi thêm 1 việc nữa là bắt tách ra theo từng khối lớp ví dụ . Cô uyên khối 6 từ 6a7 đến 6a9 (chỉ cần ghi số lớp phía sau 7-->9), khối 7 không có , khối 8 có 8a8 thì điền số 8 phía sau chữ a , khối 9 thì có 2 lớp 9a2,9a8 thì điền 2,8 . Một lần nữa xin cảm ơn bác
Họ và tênMôn dạyLớp dạy được phân côngKHỐI 6KHỐI 7KHỐI 8KHỐI 9
Trần Thị Đỗ UyênVăn6a7,6a8,6a9,8A8,9A2,9A87-->982,8
Nguyễn Trọng Ngọc Minh TrangVăn8A2,9A3,9A1523,15
Phạm Thị PhượngVăn6A13,6A14,8A6,8A913,146,9
Nguyễn Thị Xuân DungVăn7A4,7A13,8A10,8A154,1310,15
Trần Thị Mỹ DuyênVăn6A6,9A6,9A966,9
Tôn Nữ Nhật HằngVăn6A3,6A7,7A33,73
Nguyễn Thị Bích HạnhVăn8A4,8A5,9A7,9A134,57,13
Nhấp chuột vào đây để mở rộng...
Ngoài lớp A như 6A7 còn lớp B như 6B2 không?
 
khoa186 đã viết:
xin lỗi bác , mấy nay ko lên mạng được nên không trả lời bác được , bên mình chỉ có lớp A thôi bác
Nhấp chuột vào đây để mở rộng...
Mã: 
Function GopKhoi(ByVal iStr As String, ByVal Khoi As String) As String
  Dim Arr(), S, tmp$, i&, j
 
  If iStr = Empty Or Khoi = Empty Then Exit Function
  ReDim Arr(-1 To 100)
  S = Split(Replace(iStr, " ", ""), ",")
  For i = 0 To UBound(S)
    tmp = S(i)
    If Mid(tmp, 1, 1) = Khoi Then
      j = Mid(tmp, 3, 2)
      If IsNumeric(j) Then
        If j > 0 Then Arr(j) = "1"
      End If
    End If
  Next i
  tmp = Empty
  For j = 1 To 99
    If Arr(j) = "1" Then
      If Arr(j - 1) = Empty Then
        tmp = tmp & "," & j
      End If
      If Arr(j + 1) = Empty Then
        If Arr(j - 1) = "1" Then
          If Arr(j - 2) = Empty Then
            tmp = tmp & "," & j
          Else
            tmp = tmp & "-->" & j
          End If
        End If
      End If
    End If
  Next j
  GopKhoi = Mid(tmp, 2, Len(tmp))
End Function
 

File đính kèm

Lần chỉnh sửa cuối:
HieuCD đã viết:
Mã: 
Function GopKhoi(ByVal iStr As String, ByVal Khoi As String) As String
  Dim Arr(), S, tmp$, i&, j

  If iStr = Empty Or Khoi = Empty Then Exit Function
  ReDim Arr(-1 To 100)
  S = Split(Replace(iStr, " ", ""), ",")
  For i = 0 To UBound(S)
    tmp = S(i)
    If Mid(tmp, 1, 1) = Khoi Then
      j = Mid(tmp, 3, 2)
      If IsNumeric(j) Then
        If j > 0 Then Arr(j) = "1"
      End If
    End If
  Next i
  tmp = Empty
  For j = 1 To 99
    If Arr(j) = "1" Then
      If Arr(j - 1) = Empty Then
        tmp = tmp & "," & j
      End If
      If Arr(j + 1) = Empty Then
        If Arr(j - 1) = "1" Then
          If Arr(j - 2) = Empty Then
            tmp = tmp & "," & j
          Else
            tmp = tmp & "-->" & j
          End If
        End If
      End If
    End If
  Next j
  GopKhoi = Mid(tmp, 2, Len(tmp))
End Function
Nhấp chuột vào đây để mở rộng...
mình xin cảm ơn bác rất rất nhiều
 
HieuCD đã viết:
Ngoài lớp A như 6A7 còn lớp
Nhấp chuột vào đây để mở rộng...
HieuCD đã viết:
Mã: 
Function GopKhoi(ByVal iStr As String, ByVal Khoi As String) As String
  Dim Arr(), S, tmp$, i&, j
 
  If iStr = Empty Or Khoi = Empty Then Exit Function
  ReDim Arr(-1 To 100)
  S = Split(Replace(iStr, " ", ""), ",")
  For i = 0 To UBound(S)
    tmp = S(i)
    If Mid(tmp, 1, 1) = Khoi Then
      j = Mid(tmp, 3, 2)
      If IsNumeric(j) Then
        If j > 0 Then Arr(j) = "1"
      End If
    End If
  Next i
  tmp = Empty
  For j = 1 To 99
    If Arr(j) = "1" Then
      If Arr(j - 1) = Empty Then
        tmp = tmp & "," & j
      End If
      If Arr(j + 1) = Empty Then
        If Arr(j - 1) = "1" Then
          If Arr(j - 2) = Empty Then
            tmp = tmp & "," & j
          Else
            tmp = tmp & "-->" & j
          End If
        End If
      End If
    End If
  Next j
  GopKhoi = Mid(tmp, 2, Len(tmp))
End Function
Nhấp chuột vào đây để mở rộng...
Vâng chào bác , trước em có nhờ bác code giúp em từ lớp dạy phân công ra từng cột , giờ em lại mong bác giúp ngược lại từ các cột giống bên trên bác code lại giúp em lớp dạy được phân công không ạ . Em cảm ơn bác nhiều
1661008104170.png
 

File đính kèm

khoa186 đã viết:
Vâng chào bác , trước em có nhờ bác code giúp em từ lớp dạy phân công ra từng cột , giờ em lại mong bác giúp ngược lại từ các cột giống bên trên bác code lại giúp em lớp dạy được phân công không ạ . Em cảm ơn bác nhiều
View attachment 280145
Nhấp chuột vào đây để mở rộng...

Trong G2 mong muốn của bạn là "6a7,6a8,6a9 ..." mà không phải là "6A7,6A8,6A9 .." trong khi khối 8,9 lại là chữ hoa?

.
 
khoa186 đã viết:
hoa thường gì cũng được bác ạ , chắc gấp quá mình gõ nhanh , nếu hoa được bác giúp em chữ hoa nhé
Nhấp chuột vào đây để mở rộng...

Đầu câu sao bạn không viết hoa? Giáo viên nên viết đúng chính tả.

PHP: 
Public Function TachKhoi(ByVal rngTieuDe As Range, ByVal rngLich As Range) As String
Dim arrTieude, arrLich, i&, j&, temp$, v As Variant, vv As Variant
arrTieude = rngTieuDe.Value
arrLich = rngLich.Value
For i = 1 To UBound(arrLich, 2)

    If arrLich(1, i) <> "" Then
        temp = Right(arrTieude(1, i), 1) & "A"
        For Each v In Split(arrLich(1, i), ",")
            If v <> "" Then
                If InStr(1, v, "-->") = 0 Then
                    TachKhoi = TachKhoi & ", " & temp & v
                Else
                    vv = Split(v, "-->")
                    For j = vv(0) To vv(1)
                    TachKhoi = TachKhoi & ", " & temp & j
                Next j
            End If
            End If
        Next v
    End If
Next i
    If Len(TachKhoi) > 2 Then TachKhoi = VBA.Mid(TachKhoi, 3)
End Function

Công thức trong G2:

=TachKhoi($C$1:$F$1,C2:F2)

.
 
Phuocam đã viết:
Đầu câu sao bạn không viết hoa? Giáo viên nên viết đúng chính tả.

PHP: 
Public Function TachKhoi(ByVal rngTieuDe As Range, ByVal rngLich As Range) As String
Dim arrTieude, arrLich, i&, j&, temp$, v As Variant, vv As Variant
arrTieude = rngTieuDe.Value
arrLich = rngLich.Value
For i = 1 To UBound(arrLich, 2)

    If arrLich(1, i) <> "" Then
        temp = Right(arrTieude(1, i), 1) & "A"
        For Each v In Split(arrLich(1, i), ",")
            If v <> "" Then
                If InStr(1, v, "-->") = 0 Then
                    TachKhoi = TachKhoi & ", " & temp & v
                Else
                    vv = Split(v, "-->")
                    For j = vv(0) To vv(1)
                    TachKhoi = TachKhoi & ", " & temp & j
                Next j
            End If
            End If
        Next v
    End If
Next i
    If Len(TachKhoi) > 2 Then TachKhoi = VBA.Mid(TachKhoi, 3)
End Function

Công thức trong G2:

=TachKhoi($C$1:$F$1,C2:F2)

.
Nhấp chuột vào đây để mở rộng...
Thật xin lỗi bác mình bận việc quá nên không biết bác rep ,cảm ơn bác đã giúp mình. Bác ơi code chạy ok nhưng có chỗ ví dụ khối 6 , khối 7 không có phân công thì code chạy ra 6A0 , 7A0 , 8A6 .... , mình muốn chỗ nào trống mình bỏ qua được không bác . Mình xinc ảm ơn
Bài đã được tự động gộp:

Họ và tênMôn dạyKhối 6Khối 7Khối 8Khối 9Lớp dạy được phân công
Trần Minh TriếtToán8,9,10,116A0, 7A8, 7A9, 7A10, 7A11, 8A0, 9A0
Bị như vầy nè bác
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

queluatb
  • Question Question
Lấy hóa đơn đầu vào cho hóa đơn đầu ra
Trả lời
2
Đọc
139
ptm0412
ptm0412
G
Làm sao để sắp xếp nhiều cột và hàng theo abc vậy ạ ?
Trả lời
9
Đọc
177
Duy Tùng 9x
Duy Tùng 9x
C
Tính tổng một khách hàng có nhiều mã hàng nhỏ
2
Trả lời
20
Đọc
183
Duy Tùng 9x
Duy Tùng 9x
K
Lỗi chèn ảnh hàng loạt trong excel 2024
Trả lời
2
Đọc
94
kenytien
K
GPE-Trợ Lý
[GPE] HỘI THẢO POWER QUERY – CÔNG CỤ QUẢN LÝ DỮ LIỆU HCM (1 người xem)
    • Thích
Trả lời
2
Đọc
1K
ptm0412
ptm0412
K
  • Question Question
nhờ ace giúp đỡ tự động filter và In hàng loạt từng mục trong piviot table
Trả lời
10
Đọc
343
VetMini
V
H
Chuyển file *xml hóa đơn điện tử sang excel
    • Thích
Trả lời
8
Đọc
316
VetMini
V
P
Phát âm thanh tiếng việt cho dữ liệu trong file excel
Trả lời
2
Đọc
85
ongke0711
ongke0711
N
xin các cao thủ chỉ cách gỡ lỗi không khởi động được excel
Trả lời
1
Đọc
81
BuiQuangThuan
B
P
Xin tư vấn về cách tạo bảng quản lý vải
    • Cười
Trả lời
16
Đọc
327
pycckuu410
pycckuu410
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
16 17 18
Trả lời
349
Đọc
31K
tuanktt3
T
D
Nhờ các bác giúp đỡ vấn đề tìm kiếm dữ liệu
Trả lời
6
Đọc
204
Hoàng Tuấn 868
H
P
Hỏi về cách dò tìm từ dưới lên trên, dò tìm trong 2 bảng
Trả lời
7
Đọc
235
kenytien
K
D
Nhờ giúp đỡ về công thức xếp loại rèn luyện theo thông tư 22/2021/TT-BGDĐT
Trả lời
8
Đọc
184
thanthanhan
T
Maika8008
Tặng file quản lý vật tư - công nợ (nhập xuất kho hàng và công nợ khách hàng) (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
4 5 6
Trả lời
116
Đọc
25K
Thanh Tam 07
T
D
  • Đã giải quyết
Quản lý email outlook qua VBA cần giúp đỡ (1 người xem)
2
Trả lời
25
Đọc
977
befaint
befaint
A
Lấy trường dữ liệu trong file hóa đơn dạng *.xml
Trả lời
1
Đọc
180
ongke0711
ongke0711
K
Lọc một mã sản phẩm có nhiều đơn giá thành một file riêng
Trả lời
2
Đọc
154
ketoansb123
K
D
Nhờ trợ giúp xác định thứ tự của các từ và cụm từ trong 1 chuỗi văn bản.
Trả lời
10
Đọc
308
Phuocam
Phuocam
1
Vướng mắc về hàm lấy tên đăng nhập máy tính ạ (1 người xem)
Trả lời
19
Đọc
637
thuytrangbp28
T
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
[GPE] HỘI THẢO POWER QUERY – CÔNG CỤ QUẢN LÝ DỮ LIỆU HCM
Back
Top Bottom