第一次指令 design VBA code to move data from Sheet1 to newly inserted sheets based on certain group
Sub MoveData()
Dim lastRow As Long
Dim i As Long
Dim groupName As String
Dim ws As Worksheet
Dim newWs As Worksheet
'Get last row of data in Sheet1
lastRow = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
'Loop through each row of data in Sheet1
For i = 2 To lastRow 'Assuming data starts in row 2
'Get the group name from column A
groupName = ThisWorkbook.Worksheets("Sheet1").Cells(i, 1).Value
'Check if there is already a worksheet with the group name
On Error Resume Next
Set ws = ThisWorkbook.Worksheets(groupName)
On Error GoTo 0
'If there is no worksheet with the group name, insert a new worksheet
If ws Is Nothing Then
Set newWs = ThisWorkbook.Worksheets.Add(after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
newWs.Name = groupName
Else
Set newWs = ws
End If
'Copy the data from Sheet1 to the new worksheet
ThisWorkbook.Worksheets("Sheet1").Rows(i).Copy Destination:=newWs.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Next i
End Sub
第二次指令 please use 4th column as group and copy first row as header to every new sheet
Sub MoveData()
Dim lastRow As Long
Dim i As Long
Dim groupName As String
Dim ws As Worksheet
Dim newWs As Worksheet
'Get last row of data in Sheet1
lastRow = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
'Copy header row to every new sheet
ThisWorkbook.Worksheets("Sheet1").Rows(1).Copy
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Sheet1" Then
ws.Rows(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
Next ws
'Loop through each row of data in Sheet1
For i = 2 To lastRow 'Assuming data starts in row 2
'Get the group name from column D
groupName = ThisWorkbook.Worksheets("Sheet1").Cells(i, 4).Value
'Check if there is already a worksheet with the group name
On Error Resume Next
Set ws = ThisWorkbook.Worksheets(groupName)
On Error GoTo 0
'If there is no worksheet with the group name, insert a new worksheet
If ws Is Nothing Then
Set newWs = ThisWorkbook.Worksheets.Add(after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
newWs.Name = groupName
Else
Set newWs = ws
End If
'Copy the data from Sheet1 to the new worksheet
ThisWorkbook.Worksheets("Sheet1").Rows(i).Copy Destination:=newWs.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Next i
End Sub
第三次指令 please change your procedure,first get distinct group from column d ,second create sheets for each group then copy header from sheet1 finally move data. 1.先分組 2.建立所有頁面 3.複製標題 4.複製相對資料
Sub MoveData()
Dim lastRow As Long
Dim i As Long
Dim j As Long
Dim groupName As String
Dim groupNames() As String
Dim ws As Worksheet
Dim newWs As Worksheet
Dim found As Boolean
'Get last row of data in Sheet1
lastRow = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
'Get distinct group names from column D
ReDim groupNames(0 To 0)
groupNames(0) = ThisWorkbook.Worksheets("Sheet1").Cells(2, 4).Value 'Assuming data starts in row 2
For i = 2 To lastRow
groupName = ThisWorkbook.Worksheets("Sheet1").Cells(i, 4).Value
found = False
For j = 0 To UBound(groupNames)
If groupName = groupNames(j) Then
found = True
Exit For
End If
Next j
If Not found Then
ReDim Preserve groupNames(0 To UBound(groupNames) + 1)
groupNames(UBound(groupNames)) = groupName
End If
Next i
'Create new worksheet for each group name
For i = 0 To UBound(groupNames)
Set newWs = ThisWorkbook.Worksheets.Add(after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
newWs.Name = groupNames(i)
ThisWorkbook.Worksheets("Sheet1").Rows(1).Copy
newWs.Rows(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Next i
'Loop through each row of data in Sheet1 and move to appropriate worksheet
For i = 2 To lastRow 'Assuming data starts in row 2
groupName = ThisWorkbook.Worksheets("Sheet1").Cells(i, 4).Value
Set ws = ThisWorkbook.Worksheets(groupName)
ThisWorkbook.Worksheets("Sheet1").Rows(i).Copy Destination:=ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Next i
End Sub
before creating a new worksheet check if alread exists
before insert header row clear datas in that sheet
Sub MoveData()
Dim lastRow As Long
Dim i As Long
Dim j As Long
Dim groupName As String
Dim groupNames() As String
Dim ws As Worksheet
Dim newWs As Worksheet
Dim found As Boolean
'Get last row of data in Sheet1
lastRow = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
'Get distinct group names from column D
ReDim groupNames(0 To 0)
groupNames(0) = ThisWorkbook.Worksheets("Sheet1").Cells(2, 4).Value 'Assuming data starts in row 2
For i = 2 To lastRow
groupName = ThisWorkbook.Worksheets("Sheet1").Cells(i, 4).Value
found = False
For j = 0 To UBound(groupNames)
If groupName = groupNames(j) Then
found = True
Exit For
End If
Next j
If Not found Then
ReDim Preserve groupNames(0 To UBound(groupNames) + 1)
groupNames(UBound(groupNames)) = groupName
End If
Next i
'Create new worksheet for each group name if it doesn't already exist
For i = 0 To UBound(groupNames)
found = False
For Each ws In ThisWorkbook.Worksheets
If ws.Name = groupNames(i) Then
found = True
Set newWs = ws
Exit For
End If
Next ws
If Not found Then
Set newWs = ThisWorkbook.Worksheets.Add(after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
newWs.Name = groupNames(i)
newWs.Cells.ClearContents 'Clear any existing data in the new worksheet
ThisWorkbook.Worksheets("Sheet1").Rows(1).Copy
newWs.Rows(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
Next i
'Loop through each row of data in Sheet1 and move to appropriate worksheet
For i = 2 To lastRow 'Assuming data starts in row 2
groupName = ThisWorkbook.Worksheets("Sheet1").Cells(i, 4).Value
Set ws = ThisWorkbook.Worksheets(groupName)
ThisWorkbook.Worksheets("Sheet1").Rows(i).Copy Destination:=ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Next i
End Sub
prompt to get the group column number before starting
Sub MoveData()
Dim lastRow As Long
Dim i As Long
Dim j As Long
Dim groupName As String
Dim groupNames() As String
Dim ws As Worksheet
Dim newWs As Worksheet
Dim found As Boolean
Dim groupCol As Long
'Prompt user for group column number
groupCol = Application.InputBox("Enter the column number for the group:", Type:=1)
'Get last row of data in Sheet1
lastRow = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
'Get distinct group names from specified column
ReDim groupNames(0 To 0)
groupNames(0) = ThisWorkbook.Worksheets("Sheet1").Cells(2, groupCol).Value 'Assuming data starts in row 2
For i = 2 To lastRow
groupName = ThisWorkbook.Worksheets("Sheet1").Cells(i, groupCol).Value
found = False
For j = 0 To UBound(groupNames)
If groupName = groupNames(j) Then
found = True
Exit For
End If
Next j
If Not found Then
ReDim Preserve groupNames(0 To UBound(groupNames) + 1)
groupNames(UBound(groupNames)) = groupName
End If
Next i
'Create new worksheet for each group name if it doesn't already exist
For i = 0 To UBound(groupNames)
found = False
For Each ws In ThisWorkbook.Worksheets
If ws.Name = groupNames(i) Then
found = True
Set newWs = ws
Exit For
End If
Next ws
If Not found Then
Set newWs = ThisWorkbook.Worksheets.Add(after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
newWs.Name = groupNames(i)
newWs.Cells.ClearContents 'Clear any existing data in the new worksheet
ThisWorkbook.Worksheets("Sheet1").Rows(1).Copy
newWs.Rows(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
Next i
'Loop through each row of data in Sheet1 and move to appropriate worksheet
For i = 2 To lastRow 'Assuming data starts in row 2
groupName = ThisWorkbook.Worksheets("Sheet1").Cells(i, groupCol).Value
Set ws = ThisWorkbook.Worksheets(groupName)
ThisWorkbook.Worksheets("Sheet1").Rows(i).Copy Destination:=ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Next i
End Sub
Sub MoveData()
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
Dim groupCol As Long
Dim sheetName As String
'Delete all sheets except Sheet1
Application.DisplayAlerts = False
For Each ws In ThisWorkbook.Sheets
If ws.Name <> "Sheet1" Then
ws.Delete
End If
Next ws
Application.DisplayAlerts = True
'Move data from Sheet1 to newly inserted sheets based on group
Set ws = ThisWorkbook.Sheets("Sheet1")
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
groupCol = Application.InputBox("Enter the column number of the group:", "Group Column", Type:=1)
For i = 2 To lastRow
sheetName = ws.Cells(i, groupCol).Value
If Not SheetExists(sheetName) Then
ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)).Name = sheetName
ws.Rows(1).Copy Destination:=ThisWorkbook.Sheets(sheetName).Cells(1, 1)
End If
ws.Rows(i).Copy Destination:=ThisWorkbook.Sheets(sheetName).Cells(ThisWorkbook.Sheets(sheetName).Cells(ThisWorkbook.Sheets(sheetName).Rows.Count, 1).End(xlUp).Row + 1, 1)
Next i
End Sub
Function SheetExists(sheetName As String) As Boolean
Dim ws As Worksheet
On Error Resume Next
Set ws = ThisWorkbook.Sheets(sheetName)
On Error GoTo 0
SheetExists = Not ws Is Nothing
End Function
Sub CombineExcelFilesFirstSheetExceptFirstRow() Dim Path As String, Filename As String, Sheet As Worksheet, LastRow As Long, i As Integer, cFilename As String Dim wb As Workbook, DestSheet As Worksheet, LastDestRow As Long, Owb As Workbook ClearAllRowsExceptFirst Application.ScreenUpdating = False Application.CutCopyMode = False ‘ Get the path of the folder that contains the current workbook Path = ThisWorkbook.Path & “\” Set Owb = ActiveWorkbook ‘ Loop through all the Excel files in the folder Filename = Dir(Path & “.xlsx“) cFilename = ThisWorkbook.Name Do While Filename <> “” ‘ Exclude the current workbook from the merge If Filename <> cFilename Then ‘ Open each Excel file in the folder Set wb = Workbooks.Open(Filename:=Path & Filename, ReadOnly:=True) ‘ Copy the data from the first worksheet of the Excel file, excluding the first row With wb.Sheets(1) LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row If LastRow > 1 Then .Range(“A2”).Resize(LastRow – 1, .UsedRange.Columns.Count).Copy Destination:=Owb.ActiveSheet.Range(“A” & Rows.Count).End(xlUp).Offset(1, 0) End If End With ‘ Close the Excel file wb.Close End If ‘ Move to the next Excel file in the folder Filename = Dir() Loop ‘ Adjust the column widths in the current worksheet ‘For i = 1 To ActiveSheet.Columns.Count ‘ ActiveSheet.Columns(i).AutoFit ‘Next i AddConditionalFormulaToColumn Application.ScreenUpdating = True Application.CutCopyMode = True End Sub
Sub ClearAllRowsExceptFirst() With ActiveSheet .Range(“A2:” & .Cells(.Rows.Count, .Columns.Count).Address).ClearContents End With End Sub
Sub AddConditionalFormulaToColumn() Dim lastRow As Long lastRow = Cells(Rows.Count, “A”).End(xlUp).Row ‘ Assumes data is in column A Range(“U2:U” & lastRow).Formula = “=ROUND(IF(L2=””三聯式””,R2+S2,R2)*IF(B2=””STW0192″”,0.5,1),0)” ‘ Alternatively, you can use the FormulaR1C1 property to add the formula ‘ in R1C1 notation: ‘Range(“C2:C” & lastRow).FormulaR1C1 = “=IF(RC[-1]=””STW0192″”,0.5,1)” End Sub
Function Num2Str(Str As String) As String For i = 1 To Len(Str) a = Mid(Str, i, 1) Select Case True Case a = 0 aa = aa & “ 零” Case a = 1 aa = aa & “ 壹” Case a = 2 aa = aa & “ 貳” Case a = 3 aa = aa & “ 參” Case a = 4 aa = aa & “ 肆” Case a = 5 aa = aa & “ 伍” Case a = 6 aa = aa & “ 陸” Case a = 7 aa = aa & “ 柒” Case a = 8 aa = aa & “ 捌” Case a = 9 aa = aa & “ 玖” Case Else aa = aa & a End Select Next i aa = Right(“零 零 零 零 零 零 零 零 零” & aa, 18) bb = Left(aa, 6) & ” ” & Mid(aa, 7, 2) & ” ” & Mid(aa, 9, 2) & ” ” & Mid(aa, 11, 2) & Right(aa, 6) Num2Str = bb End Function
Sub 按鈕1_Click() ‘On Error Resume Next On Error GoTo MyErrorHandler: s_line = Cells(1, 8) e_line = Cells(1, 9) If Not IsNumeric(s_line) Then MsgBox (“請輸入數字”) End End If If Not IsNumeric(e_line) Then MsgBox (“請輸入數字”) End End If If s_line > e_line Then MsgBox (“請輸入正確起訖”) End End If If e_line – s_line > 4 Then MsgBox (“最多輸入5筆資料”) End End If Range(“C5:F9”).Value = “”
For i = 1 To e_line - s_line + 1
'Cells(4 + i, 3).Value = Worksheets("shipment").Cells(s_line + i - 1, 14).Value
Cells(4 + i, 3).Value = Application.WorksheetFunction.VLookup(Worksheets("shipment").Cells(s_line + i - 1, 6).Value, Worksheets("item_ref").Range("A:E"), 2, False)
Cells(4 + i, 5).Value = Worksheets("shipment").Cells(s_line + i - 1, 7).Value
Cells(4 + i, 6).Value = Worksheets("shipment").Cells(s_line + i - 1, 9).Value
Next i
Exit Sub
MyErrorHandler: If Err.Number = 1004 Then MsgBox “第” & CStr(s_line + i – 1) & “行無參照品名” Resume Next ElseIf Err.Number = 13 Then MsgBox “You have entered an invalid value.” End If
End Sub
自訂 IsInt函數 檢查是否是整數
Function IsInt(aValue as Variant) As Boolean
On Error Resume Next
IsInt = (CInt(aValue) = aValue)
On Error Goto 0
End Function
WITH cte AS (
SELECT
contact_id,
first_name,
last_name,
email,
ROW_NUMBER() OVER (
PARTITION BY
first_name,
last_name,
email
ORDER BY
first_name,
last_name,
email
) row_num
FROM
sales.contacts
)
DELETE FROM cte
WHERE row_num > 1;
Code language: SQL (Structured Query Language) (sql)
In this statement:
First, the CTE uses the ROW_NUMBER() function to find the duplicate rows specified by values in the first_name, last_name, and email columns.
Then, the DELETE statement deletes all the duplicate rows but keeps only one occurrence of each duplicate group.
SQL Server issued the following message indicating that the duplicate rows have been removed.
(4 rows affected)
If you query data from the sales.contacts table again, you will find that all duplicate rows are deleted.
SELECT contact_id,
first_name,
last_name,
email
FROM sales.contacts
ORDER BY first_name,
last_name,
email;Code language: SQL (Structured Query Language) (sql)
USE [master] GO sp_configure ‘show advanced options’, 1 GO RECONFIGURE WITH OverRide GO sp_configure ‘Ad Hoc Distributed Queries’, 1 GO RECONFIGURE WITH OverRide GO
SELECT * FROM OPENQUERY (XLSX_MATRIX, ‘Select * from [Application$]’) SELECT * FROM OPENQUERY (XLSX_MATRIX, ‘Select * from [Device$]’) SELECT * FROM OPENQUERY (XLSX_MATRIX, ‘Select * from [User$]’)
SELECT * FROM XLSX_MATRIX…[Application$] SELECT * FROM XLSX_MATRIX…[Device$] SELECT * FROM XLSX_MATRIX…[User$]
select b.*,a.item_no,a.ref_no from [XLSX_MATRIX]…[工作表1$] a right outter join [XLSX_MATRIX]…[‘原料(B倉)$’] b on a.f_2=b.f_2 where (b.ref_no like ‘%’+a.ref_no+’%’ or (a.ref_no) is null) order by 1
select b.*,a.item_no,a.ref_no from [XLSX_MATRIX]…[‘原料(B倉)$’] b left outer join [XLSX_MATRIX]…[工作表1$] a on a.f_2=b.f_2 where (b.ref_no like ‘%’+a.ref_no+’%’ or (a.ref_no) is null) and sort_id is not null order by sort_id
final** select distinct b.*,a.item_no,a.ref_no from [XLSX_MATRIX]…[‘原料(B倉)$’] b left outer join [XLSX_MATRIX]…[工作表1$] a on a.f_2=b.f_2 and (b.ref_no like ‘%’+a.ref_no+’%’ or (a.ref_no) is null) where sort_id is not null order by sort_id
select distinct b.*,a.item_no,a.ref_no,isnull(a.v_no,a.t_no) from [XLSX_MATRIX]…[‘原料(B倉)$’] b left outer join [XLSX_MATRIX]…[工作表1$] a on isnull(a.v_no,a.t_no)=b.f_2 and (b.ref_no like ‘%’+a.ref_no+’%’ or (a.ref_no) is null) where sort_id is not null order by sort_id
p.s.使用openrowset 可直接讀excel檔案,不用設置linked server select a.* from (SELECT * FROM OpenRowSet(‘Microsoft.ACE.OLEDB.12.0’, ‘Excel 12.0;HDR=Yes;IMEX=2;Database=c:\temp\Employee.xls’,[工作表1$])) a, (SELECT * FROM OpenRowSet(‘Microsoft.ACE.OLEDB.12.0’, ‘Excel 12.0;HDR=Yes;IMEX=2;Database=c:\temp\Employee.xls’,[工作表1$])) b where a.col1 = b.col1
select distinct b.*,a.item_no,a.ref_no,isnull(a.v_no,a.t_no) from (SELECT * FROM OpenRowSet(‘Microsoft.ACE.OLEDB.12.0’, ‘Excel 12.0;HDR=Yes;IMEX=1;Database=D:\SQL\vn_item_no.xlsx’,[‘原料(B倉)$’])) b left outer join (SELECT * FROM OpenRowSet(‘Microsoft.ACE.OLEDB.12.0’, ‘Excel 12.0;HDR=Yes;IMEX=1;Database=D:\SQL\vn_item_no.xlsx’,[工作表1$])) a on isnull(a.v_no,a.t_no)=b.f_2 and (b.ref_no like ‘%’+a.ref_no+’%’ or (a.ref_no) is null) where sort_id is not null order by sort_id