Mong các bạn giúp mình thu gọn liệt kê

khoa186 · 3/1/20

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ÊN	THỰC TẾ	MONG MUỐN
Lâm Kiều Trinh	6A12,7A1,7A2,7A3,7A4,7A5,7A6,7A11,7A12,7A13,7A14,7A15,7A16,9A3,9A6,9A7,9A8,9A9,9A10,9A11,9A12,9A13,9A14,9A15,9A16	6A12,7A1-->7A6,7A11-->7A16,9A3,9A6-->9A16
Lương Thị Thanh Thủy	8A1,8A2,8A3,8A4,8A5,8A6,8A7,8A8,8A9,8A10,8A11,8A12,8A13,8A14,8A15,8A16,9A1,9A2,9A3,9A4,9A5	8A1-->8A16,9A1-->9A5
Nguyễn Thu Thủy	6A1,6A2,6A3,6A4,6A5,6A6,6A7,6A8,6A9,6A10,6A11,6A12,6A13,6A14,6A15,6A16,6A17,7A7,7A8,7A9,7A10	6A1-->6A17,7A7-->7A10

khoa186 · 4/1/20

up, mong các bạn có thể giúp mình

HieuCD · 5/1/20

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ÊN THỰC TẾ MONG MUỐN
Lâm Kiều Trinh 6A12,7A1,7A2,7A3,7A4,7A5,7A6,7A11,7A12,7A13,7A14,7A15,7A16,9A3,9A6,9A7,9A8,9A9,9A10,9A11,9A12,9A13,9A14,9A15,9A16 6A12,7A1-->7A6,7A11-->7A16,9A3,9A6-->9A16
Lương Thị Thanh Thủy 8A1,8A2,8A3,8A4,8A5,8A6,8A7,8A8,8A9,8A10,8A11,8A12,8A13,8A14,8A15,8A16,9A1,9A2,9A3,9A4,9A5 8A1-->8A16,9A1-->9A5
Nguyễn Thu Thủy 6A1,6A2,6A3,6A4,6A5,6A6,6A7,6A8,6A9,6A10,6A11,6A12,6A13,6A14,6A15,6A16,6A17,7A7,7A8,7A9,7A10 6A1-->6A17,7A7-->7A10

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

khoa186 · 5/1/20

ôi dã man quá , cảm ơn bạn rất rất nhiều

Bài đã được tự động gộp: 5/1/20

GIỜ VẪN CHƯA HẾT PHÊ , CÁC BẠN GIỎI THẬT

khoa186 · 30/3/20

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

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

excel_lv1.5 · 30/3/20

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ÊN THỰC TẾ MONG MUỐN
Lâm Kiều Trinh 6A12,7A1,7A2,7A3,7A4,7A5,7A6,7A11,7A12,7A13,7A14,7A15,7A16,9A3,9A6,9A7,9A8,9A9,9A10,9A11,9A12,9A13,9A14,9A15,9A16 6A12,7A1-->7A6,7A11-->7A16,9A3,9A6-->9A16
Lương Thị Thanh Thủy 8A1,8A2,8A3,8A4,8A5,8A6,8A7,8A8,8A9,8A10,8A11,8A12,8A13,8A14,8A15,8A16,9A1,9A2,9A3,9A4,9A5 8A1-->8A16,9A1-->9A5
Nguyễn Thu Thủy 6A1,6A2,6A3,6A4,6A5,6A6,6A7,6A8,6A9,6A10,6A11,6A12,6A13,6A14,6A15,6A16,6A17,7A7,7A8,7A9,7A10 6A1-->6A17,7A7-->7A10

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)

HieuCD · 30/3/20

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

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: 30/3/20

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)

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

excel_lv1.5 · 30/3/20

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: 30/3/20

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

Tôi quên ghi chú, chuỗi phải xếp theo thứ tự tăng dần

.

khoa186 · 31/3/20

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: 30/3/20

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

đầ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ên	Môn dạy	Lớp dạy được phân công	KHỐI 6	KHỐI 7	KHỐI 8	KHỐI 9
Trần Thị Đỗ Uyên	Văn	6a7,6a8,6a9,8A8,9A2,9A8	7-->9		8	2,8
Nguyễn Trọng Ngọc Minh Trang	Văn	8A2,9A3,9A15			2	3,15
Phạm Thị Phượng	Văn	6A13,6A14,8A6,8A9	13,14		6,9
Nguyễn Thị Xuân Dung	Văn	7A4,7A13,8A10,8A15		4,13	10,15
Trần Thị Mỹ Duyên	Văn	6A6,9A6,9A9	6			6,9
Tôn Nữ Nhật Hằng	Văn	6A3,6A7,7A3	3,7	3
Nguyễn Thị Bích Hạnh	Văn	8A4,8A5,9A7,9A13			4,5	7,13

HieuCD · 31/3/20

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ên Môn dạy Lớp dạy được phân công KHỐI 6 KHỐI 7 KHỐI 8 KHỐI 9
Trần Thị Đỗ Uyên Văn 6a7,6a8,6a9,8A8,9A2,9A8 7-->9 8 2,8
Nguyễn Trọng Ngọc Minh Trang Văn 8A2,9A3,9A15 2 3,15
Phạm Thị Phượng Văn 6A13,6A14,8A6,8A9 13,14 6,9
Nguyễn Thị Xuân Dung Văn 7A4,7A13,8A10,8A15 4,13 10,15
Trần Thị Mỹ Duyên Văn 6A6,9A6,9A9 6 6,9
Tôn Nữ Nhật Hằng Văn 6A3,6A7,7A3 3,7 3
Nguyễn Thị Bích Hạnh Văn 8A4,8A5,9A7,9A13 4,5 7,13

Ngoài lớp A như 6A7 còn lớp B như 6B2 không?

khoa186 · 2/4/20

HieuCD đã viết:
Ngoài lớp A như 6A7 còn lớp B như 6B2 không?

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

HieuCD · 3/4/20

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

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

khoa186 · 3/4/20

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

mình xin cảm ơn bác rất rất nhiều

khoa186 · 20/8/22

HieuCD đã viết:
Ngoài lớp A như 6A7 còn lớp

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

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

Phuocam · 21/8/22

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

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 · 23/8/22

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

.

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é

Phuocam · 24/8/22

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é

Đầ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)

.

khoa186 · 26/9/22

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)

.

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: 26/9/22

Họ và tên	Môn dạy	Khối 6	Khối 7	Khối 8	Khối 9	Lớp dạy được phân công
Trần Minh Triết	Toán		8,9,10,11			6A0, 7A8, 7A9, 7A10, 7A11, 8A0, 9A0

Bị như vầy nè bác

Hoàng Tuấn 868 · 26/9/22

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é

Không hiểu "gấp quá" thế nào mà chỉ hơn tháng sau đã quay lại.

VetMini · 26/9/22

Hoàng Tuấn 868 đã viết:
Không hiểu "gấp quá" thế nào mà chỉ hơn tháng sau đã quay lại.

Gấp thiệt chứ. Nhưng mà gấp giấy.

Mong các bạn giúp mình thu gọn liệt kê

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

File đính kèm

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

Chuyên gia GPE

File đính kèm

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

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

Thành viên tích cực

Chuyên gia GPE

Thành viên tích cực

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

File đính kèm

Chuyên gia GPE

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

Chuyên gia GPE

File đính kèm

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

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

File đính kèm

Thành viên mới

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

Thành viên mới

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

Đăng ký hôm qua

Ăn cùng góc phố

Facebook

Group