Profil de libremacrouser - activité

Hello!

I try to write a macro code. I have a problem. I want to get a value of a cell and I want to multiplication it with other cell and paste it.

I tried to multiplication it with many ways and I couldn't it and I searched and couldn't find it. Becauase of this I write here.

My code is here:

Sub CopyPaste

xA = CreateUnoStruct("com.sun.star.table.CellAddress") 
yA = CreateUnoStruct("com.sun.star.table.CellAddress")
tA = CreateUnoStruct("com.sun.star.table.CellAddress") 
zA = CreateUnoStruct("com.sun.star.table.CellAddress")

With xA 
  .Sheet       = 0
  .Column      = 1
  .Row         = iCount6
End With
With yA 
  .Sheet       = 0
  .Column      = 1
  .Row         = iCount6
End With


With tA 'For quantity
  .Sheet       = 0
  .Column      = 2
  .Row         = iCount6
End With
With zA 
  .Sheet       = 0
  .Column      = 2
  .Row         = iCount6
End With



For iCount6 = 1 to 6 'loops through rows 1 to 6
    xA.Row = iCount6
    yA.Row = iCount6
    tA.Row = iCount6
    zA.Row = iCount6
    SourceCell = ThisComponent.Sheets(xA.Sheet).GetCellByPosition(xA.Column, xA.Row)
    SourceCell = ThisComponent.Sheets(tA.Sheet).GetCellByPosition(tA.Column, tA.Row)
    PasteCell = (ThisComponent.Sheets(yA.Sheet).GetCellByPosition(yA.Column+2, yA.Row))*(ThisComponent.Sheets(zA.Sheet).GetCellByPosition(zA.Column+1, zA.Row))
    PasteCell.DataArray = SourceCell.DataArray

Next iCount6

End Sub

In the other way I tried to get value of a cell. I added its code here.

Sub CopyPaste1

xA = CreateUnoStruct("com.sun.star.table.CellAddress") 
yA = CreateUnoStruct("com.sun.star.table.CellAddress")

dim document as object
    document = ThisComponent
    sheet4 = document.Sheets(0)


For iCount6 = 1 to 6
    With xA 
      .Sheet       = 0
      .Column      = 1
      .Row         = iCount6
    End With
    With yA 
      .Sheet       = 0
      .Column      = 1
      .Row         = iCount6
    End With
    MsgBox(sheet4.getCellByPosition(2, iCount6).Integer)

    xA.Row = iCount6
    yA.Row = iCount6
    SourceCell = ThisComponent.Sheets(xA.Sheet).GetCellByPosition(xA.Column, xA.Row)
    PasteCell = ThisComponent.Sheets(yA.Sheet).GetCellByPosition(yA.Column+2, yA.Row)*(sheet4.getCellByPosition(2, iCount6).Integer)
    PasteCell.DataArray = SourceCell.DataArray

Next iCount6

End Sub

But here there is a problem about integer. If I write string, It works but not I want. I want to paste cell with quantity. So I can't muliplication with String data.

I added example about them.

C:\fakepath\Copy-Paste Multiplication with a cell Example.ods

Edit for new example: C:\fakepath\1.ods

Edit for @JohnSUN :

Sub copyMult
Dim oSheet As Variant, oRange As Variant
Dim oData As Variant    ' Data of range, all cells of all rows in range '
Dim i As Long   
    oSheet = ThisComponent.getSheets().getByIndex(0)
Rem Get entire range - this is a bit simpler than describing each cell
    oRange = oSheet.getCellRangeByName("B2:D7") 
Rem Get values of all cells in ramge to array 
    oData = oRange.getDataArray()
Rem Repeat for each row in array
'    For i = LBound(oData) To UBound(oData)
  '  For i = 2 To 7
Rem Take the integer part of values ​​of the first and second cells and multiply it
Rem Function CInt converts any string or numeric expression to an integer
        'Const sText3 = "Tahminleri Kopyalama Tamamlandı"
     '  MsgBox(CInt(oData(2)(2 ...

Hi!

I work in a LibreOffice Macro. My code work so slowly because of my data. I have around 10,000 data in a sheet and when I write for loop and if statement, my code work is so slowly(It works about 5hours). Is there any methods to run it rapidly?

I added my code that works slowly.

Sub Main

rA = CreateUnoStruct("com.sun.star.table.CellRangeAddress")
cA = CreateUnoStruct("com.sun.star.table.CellAddress")
aaA = CreateUnoStruct("com.sun.star.table.CellRangeAddress")
abA = CreateUnoStruct("com.sun.star.table.CellAddress")
acA = CreateUnoStruct("com.sun.star.table.CellRangeAddress")
adA = CreateUnoStruct("com.sun.star.table.CellAddress")
aeA = CreateUnoStruct("com.sun.star.table.CellRangeAddress")
afA = CreateUnoStruct("com.sun.star.table.CellAddress")


'Sheet 2 'Ürün Ağaçları(Sheet Name)
Doc = ThisComponent
Sheeti2 = Doc.Sheets.getByIndex(2)
Curs = Sheeti2.createCursor
Curs.gotoEndOfUsedArea(True)
NumRows2 = Curs.Rows.Count


'Sheet 5    '3 Aylık Pivot(Sheet Name)
Doc = ThisComponent
Sheeti5 = Doc.Sheets.getByIndex(5)
Curs = Sheeti5.createCursor
Curs.gotoEndOfUsedArea(True)
NumRows5 = Curs.Rows.Count



dim document as object
    document = ThisComponent
    sheet1 = document.Sheets(5)'3 Aylık Pivot(Sheet Name)
    sheet2 = document.Sheets(2)'Ürün Ağaçları(Sheet Name)
    sheet3 = document.Sheets(6)'3 Aylık Tahmin(Sheet Name)
    sheet4 = document.Sheets(7)'Ağaçla Tahminler(Sheet Name)
    sheet5 = document.Sheets(3)'Takım Ağaçları (Sheet Name)


For iCountTree = 0 to NumRows5 '3 Aylık pivottaki satır sayısı 
For iCountTree1 = 1 to NumRows2'ürün ağacı satır sayısı 

if sheet1.getCellByPosition(0, iCountTree+5).String = sheet2.getCellByPosition(1, iCountTree1).String Then
        'Parça Kodunu copy start
            With aaA
            .Sheet       = 2
            .StartColumn = 2
            .StartRow    = iCountTree1
            .EndColumn   = 2
            .EndRow      = iCountTree1       
            End With
        'Parça Kodunu copy finish
        'Ürün Kodu copy start
            With acA
            .Sheet       = 2
            .StartColumn = 1
            .StartRow    = iCountTree1
            .EndColumn   = 1
            .EndRow      = iCountTree1       
            End With
        'Ürün Kodu copy finish
        'Parça Miktarını copy start
            With aeA
            .Sheet       = 2
            .StartColumn = 4
            .StartRow    = iCountTree1
            .EndColumn   = 4
            .EndRow      = iCountTree1       
            End With
        'Parça Miktarını copy finish

        for iCountForEmpty = 1 to NumRows2*2'Bu Sayıyı Ağaçların listesinden fazla olacak şekilde seçtim
        if sheet4.getCellByPosition(1, iCountForEmpty).String = empty then 
        'Parça Kodunu paste start
            With abA
            .Sheet       = 7
            .Column      = 2
            .Row         = iCountForEmpty
            End With
            ThisComponent.Sheets(7).CopyRange(abA, aaA)
        'Parça Kodunu paste finish
        'Ürün Kodu paste start
            With adA
            .Sheet       = 7
            .Column      = 1
            .Row         = iCountForEmpty
            End With
            ThisComponent.Sheets(7).CopyRange(adA, acA)
        'Ürün Kodu paste finish
        'Parça Miktarını paste start
            With afA
            .Sheet       = 7
            .Column      = 3
            .Row         = iCountForEmpty
            End With
            ThisComponent.Sheets(7).CopyRange(afA, aeA) 
        'Parça Miktarını paste finish

        'For to be empty to value of cells start
        'Parça Kodunu copy start
            With aaA
            .Sheet       = 2
            .StartColumn = 15
            .StartRow    = 1
            .EndColumn   = 15
            .EndRow      = 1     
            End With
        'Parça Kodunu copy finish
        'Ürün Kodu copy start
            With acA
            .Sheet       = 2
            .StartColumn = 15
            .StartRow    = 1
            .EndColumn   = 15
            .EndRow      = 1     
            End With
        'Ürün Kodu copy finish
        'Parça Miktarını copy start
            With aeA
            .Sheet       = 2
            .StartColumn = 15
            .StartRow    = 1
            .EndColumn   = 15
            .EndRow      = 1     
            End With
        'Parça Miktarını copy finish
        'For to be empty to value of cells finish

        Exit For     
        else
        end if
        next iCountForEmpty

    Else

    end if

    next iCountTree1 ...