Tengo un problema con macros en visual basic para excel y que, por más que mire, no consigo solucionar. Tengo el siguiente código:
Option Explicit
Dim oConexion As ADODB.Connection
Sub ConnectDB()
On Error GoTo err
Set oConexion = New ADODB.Connection
oConexion.Open "Provider=SQLOLEDB.1;Password=bandoiberica2015b;Integrated Security=SSPI;Persist Security Info=True;" & _
"User ID=Administrador;" & _
"Initial Catalog=BANDOIBERICA_2015;" & _
"Data Source=bandoserver3" 'ip o nombre del servidor
'MsgBox "Connexió establerta.", vbInformation, "1"
Exit Sub
err:
MsgBox "Error de connexió a la Base de dades: " & err.Description, vbInformation, ActiveWorkbook.Name
End Sub
Private Sub cargardatosCARGASSECUNDARIAS()
'***************
Dim ulti As Long
Dim Cadena As String
Dim Filas As Single, MiRango As Object
Set MiRango = Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(Filas, 0))
'***************
ConnectDB
Dim fila As Integer
Dim columna As String
Dim rs As ADODB.Recordset
'Dim RsPreu As ADODB.Recordset
fila = 10
columna = "A"
Set rs = New ADODB.Recordset
'Set RsPreu = New ADODB.Recordset
rs.Open "SELECT [Bando Ibérica, S_A_$Item].[Unit Cost], [Bando Ibérica, S_A_$Item Ledger Entry].[Global Dimension 2 Code], [Bando Ibérica, S_A_$Item Ledger Entry].[Item Category Code], " & _
" [Bando Ibérica, S_A_$Item Ledger Entry].[Item No_], [Bando Ibérica, S_A_$Item].Description, [Bando Ibérica, S_A_$Item].[Tipo medida base], " & _
" [Bando Ibérica, S_A_$Item].[Medida base], SUM([Bando Ibérica, S_A_$Item Ledger Entry].Quantity) AS STOCKCALCULADO " & _
" FROM [Bando Ibérica, S_A_$Item Ledger Entry] INNER JOIN " & _
" [Bando Ibérica, S_A_$Item] ON [Bando Ibérica, S_A_$Item Ledger Entry].[Item No_] = [Bando Ibérica, S_A_$Item].No_ " & _
" WHERE ([Bando Ibérica, S_A_$Item Ledger Entry].[Global Dimension 2 Code] = '300') OR " & _
"([Bando Ibérica, S_A_$Item Ledger Entry].[Global Dimension 2 Code] = '600') OR " & _
"([Bando Ibérica, S_A_$Item Ledger Entry].[Global Dimension 2 Code] = '700') OR " & _
"([Bando Ibérica, S_A_$Item Ledger Entry].[Global Dimension 2 Code] = '701') OR " & _
"([Bando Ibérica, S_A_$Item Ledger Entry].[Global Dimension 2 Code] = '780') OR " & _
"([Bando Ibérica, S_A_$Item Ledger Entry].[Global Dimension 2 Code] = '800') OR " & _
"([Bando Ibérica, S_A_$Item Ledger Entry].[Global Dimension 2 Code] = '830') OR " & _
"([Bando Ibérica, S_A_$Item Ledger Entry].[Global Dimension 2 Code] = '840') OR " & _
"(([Bando Ibérica, S_A_$Item Ledger Entry].[Global Dimension 2 Code] = '602') AND ([Bando Ibérica, S_A_$Item Ledger Entry].[Item Category Code] = 'BFGEN') ) OR " & _
"(([Bando Ibérica, S_A_$Item Ledger Entry].[Global Dimension 2 Code] = '880') AND ([Bando Ibérica, S_A_$Item Ledger Entry].[Item Category Code] = 'TN10') AND ([Bando Ibérica, S_A_$Item Ledger Entry].[Item Category Code] = 'TN15') ) OR " & _
"([Bando Ibérica, S_A_$Item Ledger Entry].[Global Dimension 2 Code] = '503') " & _
"GROUP BY [Bando Ibérica, S_A_$Item].[Tipo medida base],[Bando Ibérica, S_A_$Item].[Medida base], [Bando Ibérica, S_A_$Item].[Unit Cost],[Bando Ibérica, S_A_$Item Ledger Entry].[Global Dimension 2 Code], " & _
"[Bando Ibérica, S_A_$Item Ledger Entry].[Item Category Code],[Bando Ibérica, S_A_$Item Ledger Entry].[Item No_] , [Bando Ibérica, S_A_$Item].Description " & _
"ORDER BY [Bando Ibérica, S_A_$Item Ledger Entry].[Global Dimension 2 Code], [Bando Ibérica, S_A_$Item Ledger Entry].[Item Category Code], " & _
"[Bando Ibérica, S_A_$Item Ledger Entry].[Item No_] ", oConexion, adOpenStatic, adLockReadOnly
Do While Not rs.EOF
'If rs("Global Dimension 2 Code") = "600" Then
' If Left(rs("Item No_"), 5) = "B2CBR" Or Left(rs("Item No_"), 5) = "ROUND" Then
' Range("I" & fila) = rs("Unit Cost")
'RsPreu.Open "select campprecio from tablalaquesea where codproducto='" & rs("Item No_") & "' order by lafechaquesea ", oConexion, adOpenStatic, adLockReadOnly
'RsPreu.MoveLast
'Range("A" & fila) = RsPreu("camprecio")
' Range("J" & fila) = rs("Global Dimension 2 Code")
' Range("K" & fila) = rs("Item Category Code")
' Range("L" & fila) = rs("Item No_")
' Range("M" & fila) = rs("description")
' Range("N" & fila) = rs("STOCKCALCULADO")
' fila = fila + 1
' Else
' End If
If rs("Global Dimension 2 Code") = "503" Then
If Val(Right(rs("Item No_"), 2)) >= 10 Then
If Range("L" & fila) = rs("Item No_") Then
' si el producte és el mateix, no el carrega.
Range("N" & fila) = rs("STOCKCALCULADO")
fila = fila + 1
' si el producte és el mateix, no el carrega.
Range("N" & fila) = rs("STOCKCALCULADO")
fila = fila + 1
Else
Range("A" & fila + 1, "z" & fila + 1).EntireRow.Insert (xlShiftDown)
Range("C" & fila) = "1" 'original, primera carga
Range("D" & fila) = "0" 'no grabada
Range("G" & fila) = rs("Tipo medida base")
Range("H" & fila) = rs("Medida base")
Range("I" & fila) = rs("Unit Cost")
'RsPreu.Open "select campprecio from tablalaquesea where codproducto='" & rs("Item No_") & "' order by lafechaquesea ", oConexion, adOpenStatic, adLockReadOnly
'RsPreu.MoveLast
'Range("A" & fila) = RsPreu("camprecio")
Range("J" & fila) = rs("Global Dimension 2 Code")
Range("K" & fila) = rs("Item Category Code")
Range("L" & fila) = rs("Item No_")
Range("M" & fila) = rs("description")
Range("N" & fila) = rs("STOCKCALCULADO")
'Range("O" & fila) = ""
fila = fila + 1
' Filas = ActiveCell.Value2
' MiRango.EntireRow.Insert (xlShiftDown)
' ActiveCell.Offset(0, -1).Copy Destination:=MiRango.Offset(-Filas, -1)
End If
Else
End If
Else
If rs("Global Dimension 2 Code") <> "880" Then
If rs("Global Dimension 2 Code") <> "530" Then
If Range("L" & fila) = rs("Item No_") Then 'poden faltar camps a comparar
' si el producte és el mateix, no el carrega.
Range("N" & fila) = rs("STOCKCALCULADO")
fila = fila + 1
Else
Range("A" & fila, "z" & fila).EntireRow.Insert (xlShiftDown)
Range("C" & fila) = "1" 'original, primera carga
Range("D" & fila) = "0" 'no grabada
Range("G" & fila) = rs("Tipo medida base")
Range("H" & fila) = rs("Medida base")
Range("I" & fila) = rs("Unit Cost")
Range("J" & fila) = rs("Global Dimension 2 Code")
Range("K" & fila) = rs("Item Category Code")
Range("L" & fila) = rs("Item No_")
Range("M" & fila) = rs("description")
Range("N" & fila) = rs("STOCKCALCULADO")
'Range("O" & fila) = ""
fila = fila + 1
End If
End If
End If
If rs("Global Dimension 2 Code") = "880" Then
If Right(CStr(rs.Fields("Item No_").Value), 4) = "100T" Or Right(CStr(rs.Fields("Item No_").Value), 4) = "100K" Then
If Range("L" & fila) = rs("Item No_") Then
' si el producte és el mateix, no el carrega.
Range("N" & fila) = rs("STOCKCALCULADO")
fila = fila + 1
' si el producte és el mateix, no el carrega.
Range("N" & fila) = rs("STOCKCALCULADO")
fila = fila + 1
Else
Range("A" & fila + 1, "z" & fila + 1).EntireRow.Insert (xlShiftDown)
Range("C" & fila) = "1" 'original, primera carga
Range("D" & fila) = "0" 'no grabada
Range("G" & fila) = rs("Tipo medida base")
Range("H" & fila) = rs("Medida base")
Range("I" & fila) = rs("Unit Cost")
'RsPreu.Open "select campprecio from tablalaquesea where codproducto='" & rs("Item No_") & "' order by lafechaquesea ", oConexion, adOpenStatic, adLockReadOnly
'RsPreu.MoveLast
'Range("A" & fila) = RsPreu("camprecio")
Range("J" & fila) = rs("Global Dimension 2 Code")
Range("K" & fila) = rs("Item Category Code")
Range("L" & fila) = rs("Item No_")
Range("M" & fila) = rs("description")
Range("N" & fila) = rs("STOCKCALCULADO")
'Range("O" & fila) = ""
fila = fila + 1
' Filas = ActiveCell.Value2
' MiRango.EntireRow.Insert (xlShiftDown)
' ActiveCell.Offset(0, -1).Copy Destination:=MiRango.Offset(-Filas, -1)
End If
Else
End If
End If
End If
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
End Sub
Sub Sincro()
End Sub
Deseo que de la referencia 880 aparezcan únicamente los valores "100T" y "100K" y no lo logro ya que no carga dicha referencia (llega hasta la anterior, la 840).
¿Alguna idea?
Gracias!
Featured Replies
Archivado
Este tema está ahora archivado y está cerrado a más respuestas.
Buenas tardes,
Tengo un problema con macros en visual basic para excel y que, por más que mire, no consigo solucionar. Tengo el siguiente código:
Option Explicit Dim oConexion As ADODB.Connection Sub ConnectDB() On Error GoTo err Set oConexion = New ADODB.Connection oConexion.Open "Provider=SQLOLEDB.1;Password=bandoiberica2015b;Integrated Security=SSPI;Persist Security Info=True;" & _ "User ID=Administrador;" & _ "Initial Catalog=BANDOIBERICA_2015;" & _ "Data Source=bandoserver3" 'ip o nombre del servidor 'MsgBox "Connexió establerta.", vbInformation, "1" Exit Sub err: MsgBox "Error de connexió a la Base de dades: " & err.Description, vbInformation, ActiveWorkbook.Name End Sub Private Sub cargardatosCARGASSECUNDARIAS() '*************** Dim ulti As Long Dim Cadena As String Dim Filas As Single, MiRango As Object Set MiRango = Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(Filas, 0)) '*************** ConnectDB Dim fila As Integer Dim columna As String Dim rs As ADODB.Recordset 'Dim RsPreu As ADODB.Recordset fila = 10 columna = "A" Set rs = New ADODB.Recordset 'Set RsPreu = New ADODB.Recordset rs.Open "SELECT [Bando Ibérica, S_A_$Item].[Unit Cost], [Bando Ibérica, S_A_$Item Ledger Entry].[Global Dimension 2 Code], [Bando Ibérica, S_A_$Item Ledger Entry].[Item Category Code], " & _ " [Bando Ibérica, S_A_$Item Ledger Entry].[Item No_], [Bando Ibérica, S_A_$Item].Description, [Bando Ibérica, S_A_$Item].[Tipo medida base], " & _ " [Bando Ibérica, S_A_$Item].[Medida base], SUM([Bando Ibérica, S_A_$Item Ledger Entry].Quantity) AS STOCKCALCULADO " & _ " FROM [Bando Ibérica, S_A_$Item Ledger Entry] INNER JOIN " & _ " [Bando Ibérica, S_A_$Item] ON [Bando Ibérica, S_A_$Item Ledger Entry].[Item No_] = [Bando Ibérica, S_A_$Item].No_ " & _ " WHERE ([Bando Ibérica, S_A_$Item Ledger Entry].[Global Dimension 2 Code] = '300') OR " & _ "([Bando Ibérica, S_A_$Item Ledger Entry].[Global Dimension 2 Code] = '600') OR " & _ "([Bando Ibérica, S_A_$Item Ledger Entry].[Global Dimension 2 Code] = '700') OR " & _ "([Bando Ibérica, S_A_$Item Ledger Entry].[Global Dimension 2 Code] = '701') OR " & _ "([Bando Ibérica, S_A_$Item Ledger Entry].[Global Dimension 2 Code] = '780') OR " & _ "([Bando Ibérica, S_A_$Item Ledger Entry].[Global Dimension 2 Code] = '800') OR " & _ "([Bando Ibérica, S_A_$Item Ledger Entry].[Global Dimension 2 Code] = '830') OR " & _ "([Bando Ibérica, S_A_$Item Ledger Entry].[Global Dimension 2 Code] = '840') OR " & _ "(([Bando Ibérica, S_A_$Item Ledger Entry].[Global Dimension 2 Code] = '602') AND ([Bando Ibérica, S_A_$Item Ledger Entry].[Item Category Code] = 'BFGEN') ) OR " & _ "(([Bando Ibérica, S_A_$Item Ledger Entry].[Global Dimension 2 Code] = '880') AND ([Bando Ibérica, S_A_$Item Ledger Entry].[Item Category Code] = 'TN10') AND ([Bando Ibérica, S_A_$Item Ledger Entry].[Item Category Code] = 'TN15') ) OR " & _ "([Bando Ibérica, S_A_$Item Ledger Entry].[Global Dimension 2 Code] = '503') " & _ "GROUP BY [Bando Ibérica, S_A_$Item].[Tipo medida base],[Bando Ibérica, S_A_$Item].[Medida base], [Bando Ibérica, S_A_$Item].[Unit Cost],[Bando Ibérica, S_A_$Item Ledger Entry].[Global Dimension 2 Code], " & _ "[Bando Ibérica, S_A_$Item Ledger Entry].[Item Category Code],[Bando Ibérica, S_A_$Item Ledger Entry].[Item No_] , [Bando Ibérica, S_A_$Item].Description " & _ "ORDER BY [Bando Ibérica, S_A_$Item Ledger Entry].[Global Dimension 2 Code], [Bando Ibérica, S_A_$Item Ledger Entry].[Item Category Code], " & _ "[Bando Ibérica, S_A_$Item Ledger Entry].[Item No_] ", oConexion, adOpenStatic, adLockReadOnly Do While Not rs.EOF 'If rs("Global Dimension 2 Code") = "600" Then ' If Left(rs("Item No_"), 5) = "B2CBR" Or Left(rs("Item No_"), 5) = "ROUND" Then ' Range("I" & fila) = rs("Unit Cost") 'RsPreu.Open "select campprecio from tablalaquesea where codproducto='" & rs("Item No_") & "' order by lafechaquesea ", oConexion, adOpenStatic, adLockReadOnly 'RsPreu.MoveLast 'Range("A" & fila) = RsPreu("camprecio") ' Range("J" & fila) = rs("Global Dimension 2 Code") ' Range("K" & fila) = rs("Item Category Code") ' Range("L" & fila) = rs("Item No_") ' Range("M" & fila) = rs("description") ' Range("N" & fila) = rs("STOCKCALCULADO") ' fila = fila + 1 ' Else ' End If If rs("Global Dimension 2 Code") = "503" Then If Val(Right(rs("Item No_"), 2)) >= 10 Then If Range("L" & fila) = rs("Item No_") Then ' si el producte és el mateix, no el carrega. Range("N" & fila) = rs("STOCKCALCULADO") fila = fila + 1 ' si el producte és el mateix, no el carrega. Range("N" & fila) = rs("STOCKCALCULADO") fila = fila + 1 Else Range("A" & fila + 1, "z" & fila + 1).EntireRow.Insert (xlShiftDown) Range("C" & fila) = "1" 'original, primera carga Range("D" & fila) = "0" 'no grabada Range("G" & fila) = rs("Tipo medida base") Range("H" & fila) = rs("Medida base") Range("I" & fila) = rs("Unit Cost") 'RsPreu.Open "select campprecio from tablalaquesea where codproducto='" & rs("Item No_") & "' order by lafechaquesea ", oConexion, adOpenStatic, adLockReadOnly 'RsPreu.MoveLast 'Range("A" & fila) = RsPreu("camprecio") Range("J" & fila) = rs("Global Dimension 2 Code") Range("K" & fila) = rs("Item Category Code") Range("L" & fila) = rs("Item No_") Range("M" & fila) = rs("description") Range("N" & fila) = rs("STOCKCALCULADO") 'Range("O" & fila) = "" fila = fila + 1 ' Filas = ActiveCell.Value2 ' MiRango.EntireRow.Insert (xlShiftDown) ' ActiveCell.Offset(0, -1).Copy Destination:=MiRango.Offset(-Filas, -1) End If Else End If Else If rs("Global Dimension 2 Code") <> "880" Then If rs("Global Dimension 2 Code") <> "530" Then If Range("L" & fila) = rs("Item No_") Then 'poden faltar camps a comparar ' si el producte és el mateix, no el carrega. Range("N" & fila) = rs("STOCKCALCULADO") fila = fila + 1 Else Range("A" & fila, "z" & fila).EntireRow.Insert (xlShiftDown) Range("C" & fila) = "1" 'original, primera carga Range("D" & fila) = "0" 'no grabada Range("G" & fila) = rs("Tipo medida base") Range("H" & fila) = rs("Medida base") Range("I" & fila) = rs("Unit Cost") Range("J" & fila) = rs("Global Dimension 2 Code") Range("K" & fila) = rs("Item Category Code") Range("L" & fila) = rs("Item No_") Range("M" & fila) = rs("description") Range("N" & fila) = rs("STOCKCALCULADO") 'Range("O" & fila) = "" fila = fila + 1 End If End If End If If rs("Global Dimension 2 Code") = "880" Then If Right(CStr(rs.Fields("Item No_").Value), 4) = "100T" Or Right(CStr(rs.Fields("Item No_").Value), 4) = "100K" Then If Range("L" & fila) = rs("Item No_") Then ' si el producte és el mateix, no el carrega. Range("N" & fila) = rs("STOCKCALCULADO") fila = fila + 1 ' si el producte és el mateix, no el carrega. Range("N" & fila) = rs("STOCKCALCULADO") fila = fila + 1 Else Range("A" & fila + 1, "z" & fila + 1).EntireRow.Insert (xlShiftDown) Range("C" & fila) = "1" 'original, primera carga Range("D" & fila) = "0" 'no grabada Range("G" & fila) = rs("Tipo medida base") Range("H" & fila) = rs("Medida base") Range("I" & fila) = rs("Unit Cost") 'RsPreu.Open "select campprecio from tablalaquesea where codproducto='" & rs("Item No_") & "' order by lafechaquesea ", oConexion, adOpenStatic, adLockReadOnly 'RsPreu.MoveLast 'Range("A" & fila) = RsPreu("camprecio") Range("J" & fila) = rs("Global Dimension 2 Code") Range("K" & fila) = rs("Item Category Code") Range("L" & fila) = rs("Item No_") Range("M" & fila) = rs("description") Range("N" & fila) = rs("STOCKCALCULADO") 'Range("O" & fila) = "" fila = fila + 1 ' Filas = ActiveCell.Value2 ' MiRango.EntireRow.Insert (xlShiftDown) ' ActiveCell.Offset(0, -1).Copy Destination:=MiRango.Offset(-Filas, -1) End If Else End If End If End If rs.MoveNext Loop rs.Close Set rs = Nothing End Sub Sub Sincro() End Sub
Deseo que de la referencia 880 aparezcan únicamente los valores "100T" y "100K" y no lo logro ya que no carga dicha referencia (llega hasta la anterior, la 840).
¿Alguna idea?
Gracias!