Poner un contador
Ola experto
tengo una duda
deseo poner un contador para saber cuantas celdas remplazo
este es el codigo completo que tengo
este programa
remplaza los valores de una columna tomando valores de otras hojas de excel y pasandola
a una hoja principal
fecha1 = InputBox("Fecha que desea sustituir?", "ORIGEN", Now())
If fecha1 = Empty Then Exit Sub 'mejorar con revisión validez fecha
fecha2 = InputBox("Fecha nueva?", "DESTINO", Now())
If fecha2 = Empty Then Exit Sub 'mejorar con revisión fecha
'Le preguntarás al usuario por las fechas a sustituir y la nueva, y
If fecha1 < fecha2 Then
On Error Resume Next
Application.DisplayAlerts = False
MsgBox ("La Fecha que desea actualizar no se encontro")
MsgBox ("Se actualizaran incorrectamente los datos")
Selection.Replace What:="[BALANCE " & Format(fecha1, "ddmmyy"), Replacement:="[BALANCE " & Format(fecha2, "ddmmyy"), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
False, ReplaceFormat:=False
Selection.Replace What:="[MORELOS_" & UCase(Format(fecha1, "MMMM")) & "_" & Format(fecha1, "yyyy") & "_" & Format(fecha1, "dd"), Replacement:="[MORELOS_" & UCase(Format(fecha2, "MMMM")) & "_" & Format(fecha2, "yyyy") & "_" & Format(fecha2, "dd")
Selection.Replace What:="[servicios_" & UCase(Format(fecha1, "MMMM")) & "_" & Format(fecha1, "yyyy") & "_" & Format(fecha1, "dd"), Replacement:="[servicios_" & UCase(Format(fecha2, "MMMM")) & "_" & Format(fecha2, "yyyy") & "_" & Format(fecha2, "dd")
Selection.Replace What:="[rp" & Format(fecha1, "dd"), Replacement:="[rp" & Format(fecha2, "dd"), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
False, ReplaceFormat:=False
Selection.Replace What:="[DIARIO " & Format(fecha1, "dd"), Replacement:="[DIARIO " & Format(fecha2, "dd"), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
False, ReplaceFormat:=False
Selection.Replace What:="[CAPTURA_" & UCase(Format(fecha1, "yyyy")) & "_" & Format(fecha1, "MMMM") & "_" & Format(fecha1, "dd"), Replacement:="[CAPTURA_" & UCase(Format(fecha2, "yyyy")) & "_" & Format(fecha2, "MMMM") & "_" & Format(fecha2, "dd")
Selection.Replace What:="[Rep_Subd_Prod_" & UCase(Format(fecha1, "MMMM")) & "_" & Format(fecha1, "yyyy") & "_" & Format(fecha1, "dd"), Replacement:="[Rep_Subd_Prod_" & UCase(Format(fecha2, "MMMM")) & "_" & Format(fecha2, "yyyy") & "_" & Format(fecha2, "dd")
Selection.Replace What:="[MARZO-" & UCase(Format(fecha1, "ddmmyy")), Replacement:="[MARZO-" & UCase(Format(fecha2, "ddmmyy"))
Selection.Replace What:="[FAX_CPI_" & UCase(Format(fecha1, "MMMM")) & "_" & Format(fecha1, "dd"), Replacement:="[FAX_CPI_" & UCase(Format(fecha2, "MMMM")) & "_" & Format(fecha2, "dd")
MsgBox ("Los Datos se han actualizado correctamente")
Else
MsgBox ("Las Fechan estan incorrectas")
End If
donde colocarle el contador
para que me indique cuantas celdas remplazo y mostrarlas en un msgbox
espero me puedas ayudar
de antemano graciasssss
tengo una duda
deseo poner un contador para saber cuantas celdas remplazo
este es el codigo completo que tengo
este programa
remplaza los valores de una columna tomando valores de otras hojas de excel y pasandola
a una hoja principal
fecha1 = InputBox("Fecha que desea sustituir?", "ORIGEN", Now())
If fecha1 = Empty Then Exit Sub 'mejorar con revisión validez fecha
fecha2 = InputBox("Fecha nueva?", "DESTINO", Now())
If fecha2 = Empty Then Exit Sub 'mejorar con revisión fecha
'Le preguntarás al usuario por las fechas a sustituir y la nueva, y
If fecha1 < fecha2 Then
On Error Resume Next
Application.DisplayAlerts = False
MsgBox ("La Fecha que desea actualizar no se encontro")
MsgBox ("Se actualizaran incorrectamente los datos")
Selection.Replace What:="[BALANCE " & Format(fecha1, "ddmmyy"), Replacement:="[BALANCE " & Format(fecha2, "ddmmyy"), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
False, ReplaceFormat:=False
Selection.Replace What:="[MORELOS_" & UCase(Format(fecha1, "MMMM")) & "_" & Format(fecha1, "yyyy") & "_" & Format(fecha1, "dd"), Replacement:="[MORELOS_" & UCase(Format(fecha2, "MMMM")) & "_" & Format(fecha2, "yyyy") & "_" & Format(fecha2, "dd")
Selection.Replace What:="[servicios_" & UCase(Format(fecha1, "MMMM")) & "_" & Format(fecha1, "yyyy") & "_" & Format(fecha1, "dd"), Replacement:="[servicios_" & UCase(Format(fecha2, "MMMM")) & "_" & Format(fecha2, "yyyy") & "_" & Format(fecha2, "dd")
Selection.Replace What:="[rp" & Format(fecha1, "dd"), Replacement:="[rp" & Format(fecha2, "dd"), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
False, ReplaceFormat:=False
Selection.Replace What:="[DIARIO " & Format(fecha1, "dd"), Replacement:="[DIARIO " & Format(fecha2, "dd"), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
False, ReplaceFormat:=False
Selection.Replace What:="[CAPTURA_" & UCase(Format(fecha1, "yyyy")) & "_" & Format(fecha1, "MMMM") & "_" & Format(fecha1, "dd"), Replacement:="[CAPTURA_" & UCase(Format(fecha2, "yyyy")) & "_" & Format(fecha2, "MMMM") & "_" & Format(fecha2, "dd")
Selection.Replace What:="[Rep_Subd_Prod_" & UCase(Format(fecha1, "MMMM")) & "_" & Format(fecha1, "yyyy") & "_" & Format(fecha1, "dd"), Replacement:="[Rep_Subd_Prod_" & UCase(Format(fecha2, "MMMM")) & "_" & Format(fecha2, "yyyy") & "_" & Format(fecha2, "dd")
Selection.Replace What:="[MARZO-" & UCase(Format(fecha1, "ddmmyy")), Replacement:="[MARZO-" & UCase(Format(fecha2, "ddmmyy"))
Selection.Replace What:="[FAX_CPI_" & UCase(Format(fecha1, "MMMM")) & "_" & Format(fecha1, "dd"), Replacement:="[FAX_CPI_" & UCase(Format(fecha2, "MMMM")) & "_" & Format(fecha2, "dd")
MsgBox ("Los Datos se han actualizado correctamente")
Else
MsgBox ("Las Fechan estan incorrectas")
End If
donde colocarle el contador
para que me indique cuantas celdas remplazo y mostrarlas en un msgbox
espero me puedas ayudar
de antemano graciasssss
1 respuesta
Respuesta de Juan Carlos González Chavarría
1
sip gracias experto
por la ayuda
saludos cordialessssss
te lo agradecere mucho
saludossss
por la ayuda
saludos cordialessssss
te lo agradecere mucho
saludossss
Adapta este código.
Sub AboutRangeSelection()
Dim NumCols As Integer
Dim NumRows As Long
Dim NumBlocks As Integer
Dim NumCells As Long
Dim NumAreas As Integer
Dim SelType As String
Dim FirstAreaType As String
Dim CurrentType As String
Dim WhatSelected As String
Dim UnionRange As Range
Dim Area As Range
Dim Msg As String
' Quit if a range is not selected
If TypeName(Selection) <> "Range" Then Exit Sub
' Initialize counters
NumCols = 0
NumRows = 0
NumBlocks = 0
NumCells = 0
' Determine number of areas in selection
NumAreas = Selection.Areas.Count
If NumAreas = 1 Then
SelType = "Single Selection"
Else
SelType = "Multiple Selection"
End If
FirstAreaType = AreaType(Selection.Areas(1))
WhatSelected = FirstAreaType
' Build the union of all areas to avoid double-counting
Set UnionRange = Selection.Areas(1)
For Each Area In Selection.Areas
CurrentType = AreaType(Area)
' Count blocks before they're combined in the union
If CurrentType = "Block" Then NumBlocks = NumBlocks + 1
Set UnionRange = Union(UnionRange, Area)
' Change label if multiple selection is "mixed"
If CurrentType <> FirstAreaType Then WhatSelected = "Mixed"
Next Area
' Loop through each area in the Union range
For Each Area In UnionRange.Areas
Select Case AreaType(Area)
Case "Row"
NumRows = NumRows + Area.Rows.Count
Case "Column"
NumCols = NumCols + Area.Columns.Count
Case "Worksheet"
NumCols = NumCols + Area.Columns.Count
NumRows = NumRows + Area.Rows.Count
Case "Block"
' Blocks already counted in original selection above
End Select
Next Area
' Count number of non-overlapping cells
NumCells = UnionRange.Count
Msg = "Selection Type:" & vbTab & WhatSelected & vbCrLf
Msg = Msg & "No. of Areas:" & vbTab & NumAreas & vbCrLf
Msg = Msg & "Full Columns: " & vbTab & NumCols & vbCrLf
Msg = Msg & "Full Rows: " & vbTab & NumRows & vbCrLf
Msg = Msg & "Cell Blocks:" & vbTab & NumBlocks & vbCrLf
Msg = Msg & "Total Cells: " & vbTab & Format(NumCells, "#,###")
MsgBox Msg, vbInformation, SelType
End Sub
Private Function AreaType(RangeArea As Range) As String
' Returns the type of a range in an area
Select Case True
Case RangeArea.Cells.Count = 1
AreaType = "Cell"
Case RangeArea.Count = Cells.Count
AreaType = "Worksheet"
Case RangeArea.Rows.Count = Cells.Rows.Count
AreaType = "Column"
Case RangeArea.Columns.Count = Cells.Columns.Count
AreaType = "Row"
Case Else
AreaType = "Block"
End Select
End Function
Hasta aquí te puedo ayudar. Intenta hacer lo demás tú solo.
Sub AboutRangeSelection()
Dim NumCols As Integer
Dim NumRows As Long
Dim NumBlocks As Integer
Dim NumCells As Long
Dim NumAreas As Integer
Dim SelType As String
Dim FirstAreaType As String
Dim CurrentType As String
Dim WhatSelected As String
Dim UnionRange As Range
Dim Area As Range
Dim Msg As String
' Quit if a range is not selected
If TypeName(Selection) <> "Range" Then Exit Sub
' Initialize counters
NumCols = 0
NumRows = 0
NumBlocks = 0
NumCells = 0
' Determine number of areas in selection
NumAreas = Selection.Areas.Count
If NumAreas = 1 Then
SelType = "Single Selection"
Else
SelType = "Multiple Selection"
End If
FirstAreaType = AreaType(Selection.Areas(1))
WhatSelected = FirstAreaType
' Build the union of all areas to avoid double-counting
Set UnionRange = Selection.Areas(1)
For Each Area In Selection.Areas
CurrentType = AreaType(Area)
' Count blocks before they're combined in the union
If CurrentType = "Block" Then NumBlocks = NumBlocks + 1
Set UnionRange = Union(UnionRange, Area)
' Change label if multiple selection is "mixed"
If CurrentType <> FirstAreaType Then WhatSelected = "Mixed"
Next Area
' Loop through each area in the Union range
For Each Area In UnionRange.Areas
Select Case AreaType(Area)
Case "Row"
NumRows = NumRows + Area.Rows.Count
Case "Column"
NumCols = NumCols + Area.Columns.Count
Case "Worksheet"
NumCols = NumCols + Area.Columns.Count
NumRows = NumRows + Area.Rows.Count
Case "Block"
' Blocks already counted in original selection above
End Select
Next Area
' Count number of non-overlapping cells
NumCells = UnionRange.Count
Msg = "Selection Type:" & vbTab & WhatSelected & vbCrLf
Msg = Msg & "No. of Areas:" & vbTab & NumAreas & vbCrLf
Msg = Msg & "Full Columns: " & vbTab & NumCols & vbCrLf
Msg = Msg & "Full Rows: " & vbTab & NumRows & vbCrLf
Msg = Msg & "Cell Blocks:" & vbTab & NumBlocks & vbCrLf
Msg = Msg & "Total Cells: " & vbTab & Format(NumCells, "#,###")
MsgBox Msg, vbInformation, SelType
End Sub
Private Function AreaType(RangeArea As Range) As String
' Returns the type of a range in an area
Select Case True
Case RangeArea.Cells.Count = 1
AreaType = "Cell"
Case RangeArea.Count = Cells.Count
AreaType = "Worksheet"
Case RangeArea.Rows.Count = Cells.Rows.Count
AreaType = "Column"
Case RangeArea.Columns.Count = Cells.Columns.Count
AreaType = "Row"
Case Else
AreaType = "Block"
End Select
End Function
Hasta aquí te puedo ayudar. Intenta hacer lo demás tú solo.
