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

HieuCD

Chuyên gia GPE
Tham gia ngày
14 Tháng chín 2010
Bài viết
6,505
Được thích
12,206
Điểm
1,560
[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
Mã:
            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ự
Mã:
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

Trùm Nhiều Chuyện
Tham gia ngày
6 Tháng sáu 2008
Bài viết
1,354
Được thích
573
Điểm
860
Sao lại bằng được anh
Mã:
            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ự
Mã:
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
 
Lần chỉnh sửa cuối:

Huyyeu99999

Thành viên chính thức
Tham gia ngày
27 Tháng mười hai 2019
Bài viết
53
Được thích
23
Điểm
20
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 -+*/
 
Top Bottom