I don’t know any code. I created the following code using AI. The code works but it doesn’t work the way I want it to work.
What the code does: Understand the data with color code #000000 inside the cell I selected and move the data starting with this # as TEXT to the cells right next to the cell I selected in order.
Example; If the cell I selected is F3:I3, I want to move the data starting with # in it not to cells F3, G3, H3 and I3 but to the next cell J3 and if there is more than one # code, next to J3 and if there is more than one # code, next to it.
The code below works but what it does is, using the cell numbers above as an example, it defines the starting point as G3 instead of J3 and moves the #000000 codes to this G3 cell as the starting point.
Below is an example of cell construction.
Sub TasiRenkKodu
Dim oSheet As Object
Dim oCell As Object
Dim sText As String
Dim sNewText As String
Dim sColorCodes As String
Dim sColorCode As String
Dim i As Integer
Dim j As Integer
Dim oCellAddress As New com.sun.star.table.CellAddress
Dim oMergedRange As Object
Dim nStartColumn As Integer
Dim nEndColumn As Integer
Dim nNextColumn As Integer
oSheet = ThisComponent.CurrentController.ActiveSheet
oCell = ThisComponent.CurrentController.getSelection()
If IsNull(oCell) Then
MsgBox "Lütfen bir hücre seçin."
Exit Sub
End If
' Seçilen hücrenin gerçek adresini bul'
oCellAddress = oCell.getCellAddress()
' Birleştirilmiş hücre aralığını bul'
oMergedRange = oSheet.getCellRangeByPosition(oCellAddress.Column, oCellAddress.Row, oCellAddress.Column, oCellAddress.Row)
nStartColumn = oCellAddress.Column
nEndColumn = nStartColumn + oMergedRange.Columns.getCount() - 1
sText = oCell.getString()
sNewText = ""
sColorCodes = ""
i = 1
While i <= Len(sText)
If Mid(sText, i, 1) = "#" Then
j = i
While j <= Len(sText) And Mid(sText, j, 1) <> " "
j = j + 1
Wend
sColorCode = Mid(sText, i, j - i)
sColorCodes = sColorCodes & sColorCode & vbNewLine
i = j
Else
sNewText = sNewText & Mid(sText, i, 1)
i = i + 1
End If
Wend
oCell.setString(Trim(sNewText))
' Renk kodlarını doğru hücreye taşı'
nNextColumn = nEndColumn + 1
Dim oNextCell As Object
oNextCell = oSheet.getCellByPosition(nNextColumn, oCellAddress.Row)
oNextCell.setString(Trim(sColorCodes))
MsgBox "Renk kodları başarıyla taşındı."
End Sub
