返回列表 上一主題 發帖

[發問] 資料轉置貼上

Sub test_1()
Dim Arr, Brr, i&, j&, T$, R&, C%
Range("a13:g2000").ClearContents
Arr = [n13].CurrentRegion
ReDim Brr(1 To 2000, 1 To 7)
For j = 1 To UBound(Arr, 2)
    For i = 1 To UBound(Arr)
        T = Arr(i, j): If T = "" Then GoTo i01
        C = C + 1: Brr(R + 1, C) = T
        If C = 7 Then C = 0: R = R + 1
i01: Next i
Next j
[a13].Resize(R + 1, 7) = Brr
End Sub

TOP

登錄表是"XXX-111", 人員名單是"111", 怎對得上???

TOP

~~簽到記錄表 (2張)~~
打印頁是由上而下, 先左後右,
若剛好個數在25~28個之間,
第1頁14行: 左1~14, 右15~28,
第2頁12行, 是空白的!!!

TOP

先不管簽到頁數因增頁而有空白頁的問題
Xl0000798.rar (34.65 KB)

1)匯入list及載入簽到表, 分開處理, 若要一次到位, 自己再弄個程序+call
2)list比對重覆, 應是"員編+日期"才對吧!  若有問題自行調整
3)簽到表只用一張工作表, 自動依個數增加頁數

TOP

Sub 資料轉置貼上()
Dim Arr, Brr, i&, j&, T$, R&, C%
Range("a13:g2000").ClearContents
If [k13] <> "" Then Arr = Range([k13], [k65536].End(xlUp)(2))
If [n13] <> "" Then Arr = [n13].CurrentRegion
ReDim Brr(1 To 2000, 1 To 7)
If Not IsArray(Arr) Then Brr(1, 1) = Arr: GoTo 999  '若資料只有一個~~ For j = 1 To UBound(Arr, 2)
For i = 1 To UBound(Arr)
        T = Arr(i, j): If T = "" Then GoTo i01
        C = C + 1: Brr(R + 1, C) = T
        If C = 7 Then C = 0: R = R + 1
i01: Next i
Next j
999: [a13].Resize(R + 1, 7) = Brr
End Sub

TOP

        靜思自在 : 人生不一定球球是好球,但是有歷練的強打者,隨時都可以揮棒。
返回列表 上一主題