Hi,
I am just wondering if my attempts are worth pursuing or if the best I can expect is to be told by ChatGPT that “this version of code really cannot fail” (a hundred times). Please briefly consider the following.
I would like to have a macro that
- works with cells containing dates (active sheet only).
- cuts the text from these cells (and four cells on the right side), with an exception of row A which is always maintened,
- goes to the A-cell containing the corresponding date (not necessarily on the same sheet) and -crucial point - inserts the text so that any text would be be lost.
A few months ago ChatGPT wrote some macros for me for the first tiome; without it, I would never attempt this. Some macros work fine.
Could a macro like that be easily repaired, or would I be better off not wasting my time trying to do so with AI? How much would some programmer ask for this task?
Thank you.
Sub PresunDataPodleDatumu()
Dim oDoc As Object, oSheet As Object
Dim i As Long, col As Long
Dim oCell As Object, oDate As Variant
Dim qSheetName As String
Dim targetSheet As Object
Dim targetCol As Long, targetRow As Long
Dim sourceSheetName As String
Dim maxCols As Long
oDoc = ThisComponent
oSheet = oDoc.CurrentController.ActiveSheet
sourceSheetName = oSheet.getName()
maxCols = oSheet.getColumns().getCount()
For i = 1 To oSheet.getRows().getCount() - 1
For col = 0 To maxCols - 5 ' Aby bylo místo pro 4 buňky '
oCell = oSheet.getCellByPosition(col, i)
If oCell.Type = com.sun.star.table.CellContentType.VALUE Then
oDate = oCell.getValue()
If IsDate(oDate) Then
Dim datum As Date
datum = oDate
Dim mesic As Integer
mesic = Month(datum)
' Zjisti název listu dle měsíce '
Select Case mesic
Case 1 To 3
qSheetName = "Q1"
Case 4 To 6
qSheetName = "Q2"
Case 7 To 9
qSheetName = "Q3"
Case 10 To 12
qSheetName = "Q4"
Case Else
qSheetName = ""
End Select
If qSheetName <> "" Then
targetSheet = oDoc.Sheets.getByName(qSheetName)
targetCol = NajdiSloupecSPresnymDatem(targetSheet, datum)
If targetCol >= 0 Then
targetRow = NajdiPrvniPrazdnyRadek(targetSheet, targetCol)
' Zkopíruj 4 buňky vpravo '
Dim j As Integer
For j = 0 To 3
targetSheet.getCellByPosition(targetCol + j, targetRow).setValue(oSheet.getCellByPosition(col + j, i).getValue())
Next j
End If
End If
End If
End If
Next col
Next i
MsgBox "Hotovo."
End Sub
' 🔧 Pomocné funkce: '
' basic Copy Edit '
Function NajdiSloupecSPresnymDatem(oSheet As Object, hledaneDatum As Date) As Long
Dim col As Long, maxCols As Long
maxCols = oSheet.getColumns().getCount()
For col = 0 To maxCols - 1
Dim bunka As Object
bunka = oSheet.getCellByPosition(col, 0)
If bunka.Type = com.sun.star.table.CellContentType.VALUE Then
If Int(bunka.getValue()) = Int(hledaneDatum) Then
NajdiSloupecSPresnymDatem = col
Exit Function
End If
End If
Next col
NajdiSloupecSPresnymDatem = -1 ' nenalezeno '
End Function
Function NajdiPrvniPrazdnyRadek(oSheet As Object, colIndex As Integer) As Long
Dim i As Long
For i = 1 To oSheet.getRows().getCount() - 1
If oSheet.getCellByPosition(colIndex, i).getType() = com.sun.star.table.CellContentType.EMPTY Then
NajdiPrvniPrazdnyRadek = i
Exit Function
End If
Next i
NajdiPrvniPrazdnyRadek = oSheet.getRows().getCount()
End Function
