在GetRows中调整行列 [英] Transpose rows column in GetRows

问题描述

下面VBA代码做了这个工作，但是我在转置部分输了3秒钟。

有没有办法可以得到相同的结果？ SQL查询或在getrows进程中，不丢失3秒？

  Sub LoadData（）
 Dim strCon，srtQry As String，tmpArray，tmpArray2，R As Variant，i，j As Long 
 
 Set cn = CreateObject（ADODB.Connection）
设置rs = CreateObject（ADODB.Recordset） 
 
 strCon =DRIVER = {MySQL ODBC 5.2 ANSI Driver}; &安培; _ 
SERVER = localhost; &安培; _ 
DATABASE = tbname; &安培; _ 
USER = root; &安培; _ 
PASSWORD = pass; &安培; _ 
Port = 3306; &安培; _ 
Option = 3
 
 cn.Open strCon 
 
 srtQry =SELECT * FROM`tbname` WHERE`FileDay` = 20131220
 
设置rs = cn.Execute（srtQry）
 
 tmpArray = rs.GetRows 
 
 cn.Close 
 
 tmpArray2 = TransposeArray（tmpArray ）
 
 End Sub 
  

TransposeArray：

 公共函数TransposeArray（InputArr As Variant）As Variant 
 
 Dim RowNdx，ColNdx，LB1，LB2，UB1，UB2 As Long，tmpArray作为变量
 
 LB1 = LBound（InputArr，1）
 LB2 = LBound（InputArr，2）
 UB1 = UBound（InputArr，1）
 UB2 = UBound InputArr，2）
 
 ReDim tmpArray（LB2到LB2 + UB2  -  LB2，LB1到LB1 + UB1  -  LB1）
 
对于RowNdx = LB2到UB2 
 ColNdx = LB1到UB1 
 tmpArray（RowNdx，ColNdx）= InputArr（ColNdx，RowNdx）
下一个ColNdx 
下一个RowNdx 
 
 TransposeArray = tmpArray 
 
结束函数
  

解决方案

可以应用一些优化

1. 声明：您需要指定每个的数据类型变量


2. 删除 Redim中的冗余计算


3. 使用更紧凑的For循环结构


4. 将您的变体指定为数组


5. 对于大多数影响：使用 Sub 比功能

这些将减少Transpose的运行时间超过50％

  Public Sub TransposeArray（ByRef InputArr（）As Variant，ByRef ReturnArray（）As Variant）
 Dim RowNdx长一点，ColNdx As Long 
 Dim LB1 As Long，LB2 As Long，UB1 As Long，UB2 As Long 
 
 LB1 = LBound（InputArr，1）
 LB2 = LBound InputArr，2）
 UB1 = UBound（InputArr，1）
 UB2 = UBound（InputArr，2）
 
 ReDim返回数组（LB2到UB2，LB1到UB1）
 
对于RowNdx = LB2到UB2 
对于ColNdx = LB1到UB1 
 ReturnArray（RowNdx，ColNdx）= InputArr（ColNdx，RowNdx）
下一个ColNdx，RowNdx 
 
 End Sub 
  pre> 
 
 
像这样调用
  TransposeArray tmpArray，tmpArray2 
  
 
Below VBA code does the job, but I'm losing some 3 sec in the transpose part.

Is there a way I can get the same result or in the SQL query or in the getrows process without losing the 3 secs?
Sub LoadData()
Dim strCon, srtQry As String, tmpArray, tmpArray2, R As Variant, i, j As Long

Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

strCon = "DRIVER={MySQL ODBC 5.2 ANSI Driver};" & _
        "SERVER=localhost;" & _
        "DATABASE=tbname;" & _
        "USER=root;" & _
        "PASSWORD=pass;" & _
        "Port=3306;" & _
        "Option=3"

cn.Open strCon

srtQry = "SELECT * FROM `tbname` WHERE `FileDay` = 20131220"

Set rs = cn.Execute(srtQry)

tmpArray = rs.GetRows

cn.Close

tmpArray2 = TransposeArray(tmpArray)

End Sub
TransposeArray:
Public Function TransposeArray(InputArr As Variant) As Variant

Dim RowNdx, ColNdx, LB1, LB2, UB1, UB2 As Long, tmpArray As Variant

LB1 = LBound(InputArr, 1)
LB2 = LBound(InputArr, 2)
UB1 = UBound(InputArr, 1)
UB2 = UBound(InputArr, 2)

ReDim tmpArray(LB2 To LB2 + UB2 - LB2, LB1 To LB1 + UB1 - LB1)

For RowNdx = LB2 To UB2
    For ColNdx = LB1 To UB1
        tmpArray(RowNdx, ColNdx) = InputArr(ColNdx, RowNdx)
    Next ColNdx
Next RowNdx

TransposeArray = tmpArray

End Function

解决方案
There are a few optimisations you can apply

Declarations: you need to specify the data type of each variable
Remove redundant calculations in Redim
Use the more compact For loop structure
Specify your variants as arrays
And for most impact: Use a Sub rather than Function
These together will reduce run time of the Transpose by more than 50%
Public Sub TransposeArray(ByRef InputArr() As Variant, ByRef ReturnArray() As Variant)
    Dim RowNdx As Long, ColNdx As Long
    Dim LB1 As Long, LB2 As Long, UB1 As Long, UB2 As Long

    LB1 = LBound(InputArr, 1)
    LB2 = LBound(InputArr, 2)
    UB1 = UBound(InputArr, 1)
    UB2 = UBound(InputArr, 2)

    ReDim ReturnArray(LB2 To UB2, LB1 To UB1)

    For RowNdx = LB2 To UB2
    For ColNdx = LB1 To UB1
        ReturnArray(RowNdx, ColNdx) = InputArr(ColNdx, RowNdx)
    Next ColNdx, RowNdx

End Sub
Call it like this
TransposeArray tmpArray, tmpArray2


                        
这篇关于在GetRows中调整行列的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！