R：从R运行VBA函数

wfveoks0 于 2023-06-19 发布在其他

关注(0)|答案(3)|浏览(252)

我正在使用R编程语言。
我有以下数据集：

df = structure(list(var1 = c(4.39524353447787, 7.6982251051672, 25.5870831414912, 
10.7050839142458, 11.2928773516095, 27.1506498688328, 14.609162059892, 
-2.65061234606534, 3.13147148106474, 5.54338029900042), var2 = c(22.2408179743946, 
13.5981382705736, 14.0077145059405, 11.1068271594512, 4.44158865245925, 
27.8691313680308, 14.9785047822924, -9.66617156629638, 17.0135590156369, 
5.27208592272066), var3 = c(-0.678237059868451, 7.82025085341705, 
-0.260044483072397, 2.7110877070886, 3.74960732150743, -6.86693310742413, 
18.3778704449452, 11.5337311783652, -1.38136937011948, 22.5381492106993
), var4 = c(14.2646422147681, 7.04928517007729, 18.9512566104502, 
18.7813348753304, 18.2158108163749, 16.8864025410009, 15.5391765353759, 
9.38088289423278, 6.94037336260083, 6.19528998987617)), row.names = c(NA, 
-10L), class = "data.frame")

write.csv(df, "df.csv")

下面是我在Excel中从VBA编辑器运行的VBA函数：

Sub ColorCellsRowWise()
    Dim myRange As Range
    Set myRange = Range("A2:D11")

    Dim row As Range
    For Each row In myRange.Rows
        Dim cell As Range
        For Each cell In row.Cells
            If IsNumeric(cell.Value) Then
                If cell.Value = Application.WorksheetFunction.Max(row) Then
                    cell.Interior.Color = RGB(253, 127, 127)
                ElseIf cell.Value = Application.WorksheetFunction.Large(row, 2) Then
                    cell.Interior.Color = RGB(252, 181, 128)
                ElseIf cell.Value = Application.WorksheetFunction.Large(row, 3) Then
                    cell.Interior.Color = RGB(253, 247, 127)
                Else
                    cell.Interior.Color = RGB(199, 254, 126)
                End If
            End If
        Next cell
    Next row
End Sub

**我的问题：**我想知道，是否可以直接在R中运行此VBA函数？

我试着按照这里的说明（Run VBA script from R）：

library("devtools")
install_github('omegahat/RDCOMClient')

current_dir <- getwd()
file_path <- file.path(current_dir, "df.csv")
df <- read.csv(file_path)

xlApp <- COMCreate("Excel.Application")
xlWbk <- xlApp$Workbooks()$Open(file_path)

但从这里我不知道该怎么办。
我正在编写一个R脚本，其中“df”是在R中创建的，然后保存为CSV -然后我想一次性运行VBA脚本。上面链接中的方法似乎不可能。
有人能教我怎么做吗？
谢谢！

来源：https://stackoverflow.com/questions/76402413/r-run-vba-function-from-r

3条答案

按热度按时间

vulvrdjw1#

也许你不需要VBA？

library(openxlsx)

wb <- createWorkbook()
addWorksheet(wb, "Sheet 1")
writeData(wb, 1, df)

rowranks <- t(apply(-df, 1, rank))
stylecolors <- c(
  rgb(253, 127, 127, maxColorValue = 255),
  rgb(252, 181, 128, maxColorValue = 255),
  rgb(253, 247, 127, maxColorValue = 255),
  rgb(199, 254, 126, maxColorValue = 255)
)
rowranks[] <- stylecolors[rowranks]
rowranks
#       var1      var2      var3      var4     
#  [1,] "#FDF77F" "#FD7F7F" "#C7FE7E" "#FCB580"
#  [2,] "#FDF77F" "#FD7F7F" "#FCB580" "#C7FE7E"
#  [3,] "#FD7F7F" "#FDF77F" "#C7FE7E" "#FCB580"
#  [4,] "#FDF77F" "#FCB580" "#C7FE7E" "#FD7F7F"
#  [5,] "#FCB580" "#FDF77F" "#C7FE7E" "#FD7F7F"
#  [6,] "#FCB580" "#FD7F7F" "#C7FE7E" "#FDF77F"
#  [7,] "#C7FE7E" "#FDF77F" "#FD7F7F" "#FCB580"
#  [8,] "#FDF77F" "#C7FE7E" "#FD7F7F" "#FCB580"
#  [9,] "#FDF77F" "#FD7F7F" "#C7FE7E" "#FCB580"
# [10,] "#FDF77F" "#C7FE7E" "#FD7F7F" "#FCB580"

for (i in 1:nrow(df)) {
  for (j in 1:ncol(df)) {
    addStyle(wb, 1, style = createStyle(fgFill = rowranks[i, j]), rows = i+1, cols = j)
  }
}

saveWorkbook(wb, "/tmp/quux.xlsx")

赞(0）回复(0）举报 2023-06-19

jum4pzuy2#

本质上，您需要将VBA函数转换为R和RDCOMClient调用。但是，您调用的一些方法是VBA函数（例如RGB），而其他方法是Excel对象库的一部分（例如Application.*）。
因为R for循环不能在Excel对象上迭代，比如VBA的For Each，所以考虑使用Cells和Range.Cells属性的整数迭代。
最后，作为处理COM对象的最佳实践，无论是否遇到错误，都要清理后台进程，这可以用R的tryCatch来处理。

library(RDCOMClient)

csvData <- file.path(getwd(), "df.csv", fsep="\\")
RGBtoINT <- function(R, G, B) (65536 * B + 256 * G + R)

tryCatch({
    # INITIALIZE COM OBJECT
    xlApp <- COMCreate("Excel.Application")
    xlApp[["DisplayAlerts"]] <- FALSE

    # CREATE WORKBOOK
    xlWbk <- xlApp$Workbooks()$Add()

    xlWks <- xlWbk$Worksheets(1)
    xlWks[["Name"]] <- "DATAFRAME"

    # IMPORT CSV DATA
    xlQt <- xlWks$QueryTables()$Add(
      Connection=paste0("TEXT;", csvData),
      Destination=xlWks$Range("A1")
    )
    xlQt[["TextFileParseType"]] <- 1
    xlQt[["TextFileCommaDelimiter"]] <- TRUE
    xlQt$Refresh(BackgroundQuery=FALSE)
    xlQt$Delete()

    # ITERATE THROUGH ROWS AND CELLS
    for(row in 1:11) {
        rowRng <- xlWks$Range(xlWks$Cells(row, 1), xlWks$Cells(row, 4))

        for(col in 1:4) {
            cellRng <- xlWks$Cells(row, col)
            cell_value <- cellRng$Value()

            if(is.integer(cell_value) | is.numeric(cell_value)) {
                if(cell_value == xlApp$WorksheetFunction()$Max(rowRng)) {
                    cellRng[["Interior"]][["Color"]] = RGBtoINT(253, 127, 127)
                } else if(cell_value == xlApp$WorksheetFunction()$Large(rowRng, 2)) {
                    cellRng[["Interior"]][["Color"]] = RGBtoINT(252, 181, 128)
                } else if(cell_value == xlApp$WorksheetFunction()$Large(rowRng, 3)) {
                    cellRng[["Interior"]][["Color"]] = RGBtoINT(253, 247, 127)
                } else {
                    cellRng[["Interior"]][["Color"]] = RGBtoINT(199, 254, 126)
                }
            }
        }
    }

    # SHOW BACKGROUND APP
    xlApp[["Visible"]] <- TRUE

}, warning = identity

, error = function(e) {
    identity(e)
    
    # CLOSE OBJECTS
    if(exists("xlQt")) xlQt$Delete()
    if(exists("xlWbk")) xlWbk$Close(FALSE)
    if(exists("xlApp")) xlApp$Quit()

}, finally = {
    # RELEASE COM RESOURCES
    rowRng <- NULL; cellRng <- NULL; 
    xlQt <- NULL; xlWks <- NULL; xlWbk <- NULL; xlApp <- NULL
    rm(rowRng, cellRng, xlWks, xlWbk, xlApp)
})

旁白 *：请注意VBA不是Microsoft Excel的一部分，而是一个外部组件（默认情况下连接到软件）。它只是通过COM连接到Excel对象库的另一种语言，就像大多数通用编程语言（如R）一样。
输入

df <- structure(list(var1 = c(4.39524353447787, 7.6982251051672, 25.5870831414912, 
10.7050839142458, 11.2928773516095, 27.1506498688328, 14.609162059892, 
-2.65061234606534, 3.13147148106474, 5.54338029900042), var2 = c(22.2408179743946, 
13.5981382705736, 14.0077145059405, 11.1068271594512, 4.44158865245925, 
27.8691313680308, 14.9785047822924, -9.66617156629638, 17.0135590156369, 
5.27208592272066), var3 = c(-0.678237059868451, 7.82025085341705, 
-0.260044483072397, 2.7110877070886, 3.74960732150743, -6.86693310742413, 
18.3778704449452, 11.5337311783652, -1.38136937011948, 22.5381492106993
), var4 = c(14.2646422147681, 7.04928517007729, 18.9512566104502, 
18.7813348753304, 18.2158108163749, 16.8864025410009, 15.5391765353759, 
9.38088289423278, 6.94037336260083, 6.19528998987617)), row.names = c(NA, 
-10L), class = "data.frame")

write.csv(df, "ColorFormatCell.csv", row.names=FALSE)

输出