La mayoría de los novatos en esto de la programación en VBA cometen errores, que solemos llamar comúnmente como malas prácticas. ¿Cuáles son las principales malas prácticas en Excel-VBA bajo mi punto de vista?
- Utilizar código sin contexto, como por ejemplo:
Range("A1") = "Some Text" 'or Cells(5,5) = 125
Imagina que deseas insertar estos valores en Sheet2, pero cuando se ha ejecutado el código, Sheet1 estaba activo. ¿Dónde se han escrito los datos? Por supuesto, en Sheet1.
- Utilizar los métodos Select y Activate. Esta suele ser la razón de varios problemas, tales como cálculos innecesarios.
- Utilizar variables indefinidas (no declaradas explícitamente como otro tipo). En ese caso, cada variable consume más memoria de la necesaria, debido al tipo de variante.
- Código sin manipulación de errores
Para obtener más información, consulta: Excel VBA Performance Coding Best Practices.
Digamos que deseas copiar parte de los datos de Sheet1 en Sheet2. La condicion es: Level debe ser mayor que 1 (ver imagen de abajo).
Método 1. Utilizar ADODB. Recordset y Range.CopyFormRecordset
Este método es realmente sencillo. Importante, antes de ejecutar el código de abajo, tienes que insertar la referencia a Microsoft ActiveX Data Object Library x.x.
'needs reference to Microsoft ActiveX Data Object Library x.x Sub CopyData1() Dim oConn As ADODB.Connection, oRst As ADODB.Recordset Dim sConn As String, sSql As String On Error GoTo Err_CopyData1 'define connection string to itself (this workbook) sConn = "Provider=Microsoft.ACE.OLEDB.12.0;_ Data Source=" & ThisWorkbook.FullName & ";_ Extended Properties='Excel 12.0 Macro;HDR=YES';" 'create and open connection Set oConn = New ADODB.Connection With oConn .ConnectionString = sConn .Open End With 'define query sSql = "SELECT [Part_Number], [Name], [Version], [Level]" & vbCr & _ "FROM [Sheet1$A1:D100]" & vbCr & _ "WHERE [Level]>1;" 'create and open recordset Set oRst = New ADODB.Recordset oRst.Open sSql, oConn, adOpenStatic, adLockReadOnly 'context!!! With ThisWorkbook.Worksheets("Sheet2") 'clear precious data .Range("A2:D10000").Delete xlShiftUp 'insert filtered data .Range("A2").CopyFromRecordset oRst End With 'exit subroutine Exit_CopyData1: 'ignore errors and clean up On Error Resume Next If Not oConn Is Nothing Then oConn.Close Set oConn = Nothing If Not oRst Is Nothing Then oRst.Close Set oRst = Nothing Exit Sub 'error handler Err_CopyData1: MsgBox Err.Description, vbExclamation, Err.Number Resume Exit_CopyData1 End Sub
En caso de que desees obtener datos de otro workbook o desees consultar una versión anterior de los archivos de MS Excel, tendrás que cambiar el string de conexión. Si deseas saber cómo copiar datos en hojas nuevas o existentes en un workbook diferente, echa un vistazo al siguiente método.
Método 2: Utilizando Do/While y For...Next
Sub CopyData2() Dim srcWsh As Worksheet, dstWsh As Worksheet Dim i As Integer, j As Integer On Error GoTo Err_CopyData2 'define context Set srcWsh = ThisWorkbook.Worksheets("Sheet1") Set dstWsh = ThisWorkbook.Worksheets("Sheet2") 'clear range before you start copying dstWsh.Range("A2:D10000").Clear 'starting rows i = 2 j = 2 'loop though the data Do While srcWsh.Range("A" & i) <> "" 'go to skip soubroutine if Level is equal to 1 If srcWsh.Range("D" & i) = 1 Then GoTo SkipThisRow 'copy set of columns - in this case A to D, but it might be: A, C, E, G With dstWsh .Range("A" & j) = srcWsh.Range("A" & i) .Range("B" & j) = srcWsh.Range("B" & i) .Range("C" & j) = srcWsh.Range("C" & i) .Range("D" & j) = srcWsh.Range("D" & i) End With 'increase row number in Sheet2 j = j + 1 'skip subroutine SkipThisRow: 'increase row number in Sheet1 i = i + 1 Loop Exit_CopyData2: On Error Resume Next Set srcWsh = Nothing Set dstWsh = Nothing Exit Sub Err_CopyData2: MsgBox Err.Description, vbExclamation, Err.Number Resume Exit_CopyData2 End Sub
¿Por qué un conjunto de columnas han sido codificadas en el anterior ejemplo? La respuesta es bastante fácil. Es posible que desees copiar los datos en un orden distinto o en un rango diferente.
Método 3: Utilizando FilterAndCopy
Sub FilterAndCopy() Dim srcWsh As Worksheet Dim dstWsh As Worksheet Set wsSource = ThisWorkbook.Worksheets("Sheet1") Set wsTarget = ThisWorkbook.Worksheets("Sheet2") On Error GoTo Err_FilterAndCopy 'clear the destination range dstWsh.Range("A2:A10000").Clear 'filter and copy data With srcWsh .Range("A1").AutoFilter ' turn on filter .UsedRange.AutoFilter Field:=4, Criteria1:=">1" 'paste data into destination worksheet .UsedRange.Copy Destination:=dstWsh.Range("A2") End With 'turn of CutCopyMode and filter Application.CutCopyMode = False srcWsh.Range("A1").AutoFilter Exit_FilterAndCopy: On Error Resume Next Set srcWsh = Nothing Set dstWsh = Nothing Exit Sub Err_FilterAndCopy: MsgBox Err.Description, vbCritical, Err.Number Resume Exit_FilterAndCopy End Sub
Fuente: Maciej Los