錯誤訊息
Remote server replied: 550-5.7.26 This mail is unauthenticated, which poses a security risk to the
550-5.7.26 sender and Gmail users, and has been blocked. The sender must
550-5.7.26 authenticate with at least one of SPF or DKIM. For this message, 550-5.7.26 DKIM checks did not pass and SPF check for
今天終於拿到DNS管理帳密，登入twnic找到DNS管理，新增一筆 TXT紀錄
Value: v=spf1 ip4:192.168.x.x 如下圖(此ip為對外發信實體IP)，這樣就解決啦。
https://support.google.com/a/answer/10685031?sjid=15193580675983634622-AP
第一次指令 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
最終結果與預期需求相符，感想：優點過程中打錯字或是文法不對，chatGPT還是能夠大致了解，感覺語文理解力很強，程式範例庫眾多，基礎語法與程式架構標準化。缺點是流程運行前後邏輯較差，透過子模組切分與流程先後串聯提示可改善。
bing + Chatgpt 4.0 不須指示先按group建立sheet，coding 能力似乎又強化
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