Giúp code chèn mã phòng thi cho khoảng 14 ngàn HS

[titanic20072007]

Chào các bạn. Hôm nay mình có tình huống nhờ các bạn giúp code để chạy nhanh hơn công thức. Cụ thể:
Trong bảng ở Sheet1: Mỗi trường có nhiều phòng thi. Mỗi phòng thi có mã phòng riêng. Cần chèn mã phòng thi ở Sheet1 vào từng HS ở Sheet2 sao cho HS của trường nào, ở phòng nào thì điền mã phòng tương ứng ở Sheet1. Có tệp đính kèm. Cảm ơn các bạn.

 

[HieuCD]

[QUOTE
For x = SoRow To Tongsophong
SoRow = SoRow + 1 ' cái này thừa, xem bên dưới
xphong = xphong + 1
Arr2(x, 1) = Arr1(i, 1)
Arr2(x, 2) = xphong
Arr2(x, 9) = Arr1(i, 4 + xphong)
Next x
' chạy đến đây, SoRow luôn luôn bằng x = Tongsophong + 1
' trừ phi trước đó SoRow > Tongsophong

Sao lại bằng được anh

            Tongsophong = Tongsophong + Arr1(i, 4)
            xphong = 0
            For x = SoRow To Tongsophong
                SoRow = SoRow + 1
                xphong = xphong + 1
                Arr2(x, 1) = Arr1(i, 1)
                Arr2(x, 2) = xphong
                Arr2(x, 9) = Arr1(i, 4 + xphong)
            Next x

Ghi chú được thì tốt sau này dễ chỉnh sửa. Tuy nhiên tùy theo mỗi người yêu cầu chủ top làm sao em làm vậy.
Còn chủ top quan tâm code thì tự khắc sẽ tự hỏi. Còn tin tưởng muốn sài hay không là do chủ top (Muốn ăn phải lăn vào bếp mà)
PS: Vì đây là diễn đàn Free và Code Free nên tác giả không đảm bảo tính chính xác của số liệu thế thôi, tác giả chỉ viết theo cách hiểu của tác giả.
[/QUOTE]
Một cách đánh số thứ tự

Sub ABC()
  Dim sArr(), Res(), Res2()
  Dim eRow&, sRow&, i&, j&
  Dim TongSoPhong&, SoPhong&, stt&, sttPhong&, TenTruong$
  With Sheet1
      eRow = .Range("B65000").End(xlUp).Row
      sArr = .Range("B5:S" & eRow).Value
      TongSoPhong = Application.Sum(.Range("E5:E" & eRow))
  End With
  sRow = UBound(sArr)
  ReDim Res(1 To TongSoPhong, 1 To 3) 'Tach 2 ket qua
  ReDim Res2(1 To TongSoPhong, 1 To 1)'Chay code mon khac chi can Res2
  For i = 1 To sRow
      TenTruong = sArr(i, 1)
      SoPhong = sArr(i, 4)
      sttPhong = 0 'Danh lai stt bat dau tu 1
      For j = 1 To SoPhong
          stt = stt + 1
          sttPhong = sttPhong + 1
          Res(stt, 1) = stt
          Res(stt, 2) = TenTruong
          Res(stt, 3) = sttPhong
          Res2(stt, 1) = sArr(i, j + 4)
      Next j
  Next i
  With Sheets("sheet2")
      eRow = .Range("B65000").End(xlUp).Row
      If eRow > 6 Then 'Xoa ket qua cu
        .Range("A7:C" & eRow).ClearContents
        .Range("J7:J" & eRow).ClearContents
      End If
      .Range("A7").Resize(TongSoPhong, 3) = Res
      .Range("J7").Resize(TongSoPhong) = Res2
  End With
  Erase sArr:  Erase Res:  Erase Res2
End Sub

 

[thuyyeu99]

Thưởng cho anh dĩa nè

 

[thuyyeu99]

Sao lại bằng được anh

            Tongsophong = Tongsophong + Arr1(i, 4)
            xphong = 0
            For x = SoRow To Tongsophong
                SoRow = SoRow + 1
                xphong = xphong + 1
                Arr2(x, 1) = Arr1(i, 1)
                Arr2(x, 2) = xphong
                Arr2(x, 9) = Arr1(i, 4 + xphong)
            Next x

Ghi chú được thì tốt sau này dễ chỉnh sửa. Tuy nhiên tùy theo mỗi người yêu cầu chủ top làm sao em làm vậy.
Còn chủ top quan tâm code thì tự khắc sẽ tự hỏi. Còn tin tưởng muốn sài hay không là do chủ top (Muốn ăn phải lăn vào bếp mà)
PS: Vì đây là diễn đàn Free và Code Free nên tác giả không đảm bảo tính chính xác của số liệu thế thôi, tác giả chỉ viết theo cách hiểu của tác giả.

Một cách đánh số thứ tự

Sub ABC()
  Dim sArr(), Res(), Res2()
  Dim eRow&, sRow&, i&, j&
  Dim TongSoPhong&, SoPhong&, stt&, sttPhong&, TenTruong$
  With Sheet1
      eRow = .Range("B65000").End(xlUp).Row
      sArr = .Range("B5:S" & eRow).Value
      TongSoPhong = Application.Sum(.Range("E5:E" & eRow))
  End With
  sRow = UBound(sArr)
  ReDim Res(1 To TongSoPhong, 1 To 3) 'Tach 2 ket qua
  ReDim Res2(1 To TongSoPhong, 1 To 1)'Chay code mon khac chi can Res2
  For i = 1 To sRow
      TenTruong = sArr(i, 1)
      SoPhong = sArr(i, 4)
      sttPhong = 0 'Danh lai stt bat dau tu 1
      For j = 1 To SoPhong
          stt = stt + 1
          sttPhong = sttPhong + 1
          Res(stt, 1) = stt
          Res(stt, 2) = TenTruong
          Res(stt, 3) = sttPhong
          Res2(stt, 1) = sArr(i, j + 4)
      Next j
  Next i
  With Sheets("sheet2")
      eRow = .Range("B65000").End(xlUp).Row
      If eRow > 6 Then 'Xoa ket qua cu
        .Range("A7:C" & eRow).ClearContents
        .Range("J7:J" & eRow).ClearContents
      End If
      .Range("A7").Resize(TongSoPhong, 3) = Res
      .Range("J7").Resize(TongSoPhong) = Res2
  End With
  Erase sArr:  Erase Res:  Erase Res2
End Sub

[/QUOTE]
Code anh viết thì đẹp rõ ràng rồi khỏi bàn cải vụ này (em đọc Code của anh nhiều rồi mà hihi)
TongSoPhong = Application.Sum(.Range("E5:E" & eRow)) =>Em có ý tưởng khác nên không là Sum ấy chứ
Còn
ReDim Res(1 To TongSoPhong, 1 To 3) 'Tach 2 ket qua
ReDim Res2(1 To TongSoPhong, 1 To 1)'Chay code mon khac chi can Res2
Em không tách đợi chủ top lên tiếng. (tách ra Arrar như anh là hợp lý nhất)
Tại sao em để Dic cốt lõi là em muốn kiểm tra trùng.(theo quan điểm cá nhân của em)

Mà tóm lại nhìn Code của anh trình bày lại rõ ràng đúng, hợp lý hơn em nhiều hihi

 

[Huyyeu99999]

For x = SoRow To Tongsophong ' sorow = x at the first entry
SoRow = SoRow + 1 ' sorow = x + 1
Mỗi lượt vòng về thì x tăng lên 1. Nếu x <= tongsophong thì bước vào vòng lặp và sorow tăng lên 1, tức là sorow vẫn = x + 1
Lượt cuối cùng x = tongsophong, vẫn bước vào vòng lặp thì sorow = tongsophong + 1
Đến lượt kế đó, x = tongsophong + 1 thì không bước vào vòng lặp nữa, nhưng sorow đã là (x-1) + 1 = tongsophong + 1

Nhìn code thì biết bạn chưa hiểu hết lý thuyết vòng lặp cho nên tôi mách. Chứ bắt bẻ bạn thì được gì.

Còn cái vụ comments của code thì tôi biết là "truyền thống" của diễn đàn này. Người hỏi bài bắt buộc nhập gia tuỳ tục.

Lại mắc phải cái Lỗi này của anh, làm tốn 2 ngày trời hichic