返回列表 上一主題 發帖

[發問] Excel 單欄資料轉多欄

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2025-1-10 
1# 跳轉到 »
發表於 2022-9-12 16:38 | 顯示全部帖子
您好，
我有一個"檢核板號.xlsm"讓使用者於A1.A2.A3.A4分別輸入特定資料，每4筆資料為一組。

目前我於F ...
pointchi 發表於 2022-9-11 23:58


新增如下，請測試看看，謝謝

Sub Step01()

M1 = Format(Now, "MM")
D1 = Format(Now, "DD")
H1 = Format(Now, "HH")
N1 = Format(Now, "NN")

    Columns("F:I").Select
    Selection.Copy
    Workbooks.Add
    Columns("A:A").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
Dim xR As Range, xU As Range
For Each xR In ActiveSheet.Range("C:C").SpecialCells(xlCellTypeConstants).Rows
    If Not IsError(Application.Match(0, xR, 0)) Then
        If xU Is Nothing Then Set xU = xR Else Set xU = Union(xR, xU)
     End If
Next
If Not xU Is Nothing Then xU.EntireRow.Delete

   
    Application.CutCopyMode = False
    ActiveWorkbook.SaveAs Filename:="C:\Users\Point\OneDrive\桌面\" & M1 & D1 & "-" & H1 & N1 & ".xlsx"
End Sub

TOP

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2025-1-10 
2#
發表於 2022-9-15 12:40 | 顯示全部帖子
回復 3# pointchi

借用Andy2483前賢程式碼，修改一下，請測試看看，謝謝
Sub test()
Dim MDHN, i&, Arr, Brr, R&, C%
MDHN = Format(Now, "MMDD-HHNN")
Arr = Range([A1], Cells(Rows.Count, "A").End(3))
ReDim Brr(1 To UBound(Arr) / 4, 1 To 4)
For i = 1 To UBound(Arr)
    C = C + 1: Brr(R + 1, C) = Arr(i, 1)
    If C = 4 Then C = 0: R = R + 1
Next
Workbooks.Add
[A1].Resize(1, 4) = Array("料號", "數量", "板號", "儲位")
[A2].Resize(UBound(Brr), 4) = Brr
[A:D].Columns.AutoFit
ActiveWorkbook.SaveAs Filename:="C:\Users\Point\OneDrive\桌面\" & MDHN & ".xlsx"
End Sub

TOP

        靜思自在 : 做好事不能少我一人，做壞事不能多我一人。
返回列表 上一主題