如何将数据复制到单元格中，制作表格并向其中添加更多数据

Posted 2023-02-24

【中文标题】如何将数据复制到单元格中，制作表格并向其中添加更多数据

【英文标题】：How to copy data into cells, make a table and add more data to it

【发布时间】：2021-06-02 07:53:19

【问题描述】：

界面如下： 帐户：威塞克斯银行有限公司 收入：200 欧元 费用： 日期：28.02.2021输出应该是下面单元格中的列表： 日期： |帐户： |收入：|费用：|

28.02.2021 |威塞克斯银行 | 200 欧元 | 2021 年 2 月 28 日 |食品 | - | 175 欧元 |提示：我想要一份包含 5-7 次预订的清单以及时间 进行新预订 最新预订将位于顶部位置，第一个预订位于最后一行，例如当表格从第 13 行开始并且我使用不同帐户进行 5 次预订时，第一个预订将在第 17 行结束。这是复制表格中的内容

Sub MyBuchenMakro   
    Dim currDoc As Object
    Dim currSheet As Object
    Dim curr Cell As Object
    Dim destCell As Object  
    Dim oDate As Date
    Dim einnahmen As Currency
    Dim ausgaben As Currency  
    currDoc = ThisComponent
    currSheet = currDoc.sheets(0)  
    currCell = currSheet.getCellByPosition(1, 5)
    destCell = currSheet.getCellByPosition(1, 12)
    destCell.String = currCell.String  
    currCell = currSheet.getCellByPosition(1, 6)
    destCell = currSheet.getCellByPosition(2, 12)
    destCell.setValue(CCur(currCell.getValue()))  
    currCell = currSheet.getCellByPosition(1, 7)
    destCell = currSheet.getCellByPosition(3, 12)
    destCell.setValue(CCur(currCell.getValue()))  
    currCell = currSheet.getCellByPosition(1, 8)
    destCell = currSheet.getCellByPosition(0, 12)
    destCell.setValue(CDate(currCell.getValue()))    
For i = 160 To 13 Step 1
  destCell = currSheet.getCellByPosition(0, i)
  If destCell == "" Then
     GoTo Continue
  End if
destCell = currSheet.getCellByPosition(0,i+1)
destCell.setValue(CDate(currCell.getValue()))
currCell = currSheet.getCellByPosition(1,i)
destCell = currSheet.getCellByPosition(1,i+1)
destCell.String = currCell.String
currCell = currSheet.getCellByPosition(2,i)
destCell = currSheet.getCellByPosition(2,i+1)
destCell.setValue(CCur(currCell.getValue()))
currCell = currSheet.getCellByPosition(3,i)
destCell = currSheet.getCellByPosition(3,i+1)
destCell.setValue(CCur(currCell.getValue()))
 Next i
End Sub  


  [1]: https://i.stack.imgur.com/Mw7pJ.png

【问题讨论】：

已完成编辑，希望对您有所帮助

欢迎您！据我了解您的代码，第 12 行已经填充了标题“日期：| 帐户：| 收入：| 成本：|”？整个任务归结为在已经填写的表格中查找预订日期不大于在“输入表单”日期字段中输入的日期的行，在此位置插入新行并将四个输入字段的值传输到这个新行，不是吗？

第 12 行将是表格的标题。我也想将日期添加到表格中。我不会将日期与某事进行比较。

【参考方案1】：

其实写的稍微短一点：

Option Explicit 
Sub BuchenMacro
Dim oCurrentController As Variant   ' get Activesheet and select first cell of form
Dim oSheet As Variant   ' Activesheet
Dim oSourceRange As Variant ' Range B6:B9 - fields of input form
Dim oDataArray As Variant           ' Data from input form
    oCurrentController = ThisComponent.getCurrentController()
    oSheet = oCurrentController.getActiveSheet()
Rem Range with data
    oSourceRange = oSheet.getCellRangeByName("B6:B9")
Rem Data from this range as "array of arrays"
    oDataArray = oSourceRange.getDataArray()
Rem To prevent insert empty row - validate source cells:
Rem If 3 first cells are empty then stop:
    If Trim(oDataArray(0)(0))+Trim(oDataArray(1)(0))+Trim(oDataArray(2)(0)) = "" Then Exit Sub 
Rem "Transpose" source data to single row:
    oDataArray = Array(Array(oDataArray(3)(0), oDataArray(0)(0), oDataArray(1)(0), oDataArray(2)(0)))
Rem Insert new row after header and shift all other rows down:
    oSheet.getRows().insertByIndex(12, 1)
Rem Paste data from form to this new row
    oSheet.getCellRangeByPosition(0, 12, 3, 12).setDataArray(oDataArray)
Rem Clear input cells to prevent duplicates
Rem (Only the data is cleared, the formulas remain in place. 
Rem Put in cell B9 the formula =TEXT(TODAY();"DD.MM.YYYY")
Rem and it will always show the current date)
    oSourceRange.clearContents(7)
Rem Select first cell
    oCurrentController.Select(oSheet.getCellByPosition(1,5))
Rem Deselect cell
    oCurrentController.Select(ThisComponent.createInstance("com.sun.star.sheet.SheetCellRanges"))
End Sub

【讨论】：

谢谢，它工作得很好，但我有一个小问题：在我的表中，我将列标题收入和成本设置为彩色（绿色和红色），当运行宏时，数据将被放入表格中，但是 Libre 正在从上面的单元格中获取格式，然后也为数据记录着色

是的，这是个问题。但这可以通过一行代码解决。插入新行后立即清除oSheet.getCellRangeByPosition(0, 12, 3, 12).clearContents(32).clearContents()方法的参数值见here

是的，谢谢这解决了问题，但是当我在行插入之后或之前插入它时，数据记录的格式将设置不同。实际上货币和日期格式被转换为数字格式，例如我得到日期的数值而不是日期。