Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Excel » cambio de , por .

Excel - cambio de , por .

Volver
Nuevo Tema
<<>>
 
Vista:

cambio de , por .

Publicado por Reyes Pérez (3 intervenciones) el 28/03/2023 10:40:09
Buenos días, he realizado una macro para una limpieza de unos archivos, pero al ejecutarla me hace un cambio bastante extraño, me cambia los puntos de miles por , y los coge como numero decimal. Por ejemplo, si antes ene l xls tenia un 1.000, cuando ejecuto la macro se convierte en un 1.

La macro sería la siguiente:

Sub Macro_contratos_1B()
Dim xFd As FileDialog
Dim xFdItem As Variant
Dim xFileName As String
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
If xFd.Show = -1 Then
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
Do While xFileName <> ""
With Workbooks.Open(xFdItem & xFileName)
Range("A:E").Columns.Delete

Dim Fila As Long

For Fila = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
If WorksheetFunction.CountA(ActiveSheet.Rows(Fila)) = 0 Then
Cells(Fila, 1).EntireRow.Delete
End If
Next Fila


Range("A1").Select
If AutoFilter = OFF Then Selection.AutoFilter
ActiveSheet.Range("$A$1:$CG$124286").AutoFilter Field:=1, Criteria1:="< 100000", Operator:=xlFilterValues
ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete

Range("A1").Select
If AutoFilter = OFF Then Selection.AutoFilter
ActiveSheet.Range("$A$1:$CG$124286").AutoFilter Field:=1, Criteria1:="=", Operator:=xlFilterValues
ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete

Range("A1").Select
If AutoFilter = OFF Then Selection.AutoFilter
ActiveSheet.Range("$A$1:$CG$124286").AutoFilter Field:=1, Criteria1:="C-Nº contr", Operator:=xlFilterValues
ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete

Range("A1").Select
If AutoFilter = OFF Then Selection.AutoFilter
ActiveSheet.Range("$A$1:$CG$124286").AutoFilter Field:=1, Criteria1:="SI", Operator:=xlFilterValues
ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData


Set MR = Range("A1:BE1")
For Each cell In MR
If cell.Value = Empty Then cell.EntireColumn.ClearContents
Next

Dim n As Integer 'nº columnas
Dim i As Integer
Dim col As String

n = ActiveSheet.UsedRange.Columns.Count
For i = n To 1 Step -1
If WorksheetFunction.CountA(Cells(1, i).EntireColumn) = Empty Then
Cells(1, i).EntireColumn.Delete
End If
Next i


ActiveSheet.Range("T1:T" & Range("T" & Rows.Count).End(xlUp).Row).Replace ",", "."

ActiveSheet.Range("Y1:Y" & Range("Y" & Rows.Count).End(xlUp).Row).Replace ",", "."

RutaArchivo = "C:\Users\u15285\Desktop\CONTRATOS\Archivos excel\"
NombreArchivo = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4)
ActiveWorkbook.SaveAs Filename:=RutaArchivo & NombreArchivo & ".xlsx", FileFormat:=51

Selection.AutoFilter


Range("A1").Select
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$BE$" & Range("K" & Rows.Count).End(xlUp).Row), , xlYes). _
Name = "Tabla3"
Range("Tabla3[#All]").Select

Columns("H:H").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("H2").Select
ActiveCell.FormulaR1C1 = _
"=DATE(MID(RC[-1],7,4),MID(RC[-1],4,2),MID(RC[-1],1,2))"
Range("H2").Select
Selection.AutoFill Destination:=Range("H2:H" & Range("G" & Rows.Count).End(xlUp).Row)
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("H2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("G1").Select
Application.CutCopyMode = False
Selection.Copy
Range("H1").Select
ActiveSheet.Paste
Columns("G:G").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft

Columns("I:I").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("I2").Select
ActiveCell.FormulaR1C1 = _
"=DATE(MID(RC[-1],7,4),MID(RC[-1],4,2),MID(RC[-1],1,2))"
Range("I2").Select
Selection.AutoFill Destination:=Range("I2:I" & Range("H" & Rows.Count).End(xlUp).Row)
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("I2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("H1").Select
Application.CutCopyMode = False
Selection.Copy
Range("I1").Select
ActiveSheet.Paste
Columns("H:H").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft

Columns("D:D").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("D2").Select
ActiveCell.FormulaR1C1 = _
"=DATE(MID(RC[-1],7,4),MID(RC[-1],4,2),MID(RC[-1],1,2))"
Range("D2").Select
Selection.AutoFill Destination:=Range("D2:D" & Range("C" & Rows.Count).End(xlUp).Row)
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("D2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("C1").Select
Application.CutCopyMode = False
Selection.Copy
Range("D1").Select
ActiveSheet.Paste
Columns("C:C").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft


Dim columnaAEliminar As Range
Set columnaAEliminar = ActiveSheet.Rows(1).Find("Columna1", LookIn:=xlValues, LookAt:=xlWhole)

If Not columnaAEliminar Is Nothing Then
columnaAEliminar.EntireColumn.Delete
End If

Dim columnaAEliminar2 As Range
Set columnaAEliminar2 = ActiveSheet.Rows(1).Find("Columna2", LookIn:=xlValues, LookAt:=xlWhole)

If Not columnaAEliminar2 Is Nothing Then
columnaAEliminar2.EntireColumn.Delete
End If

Dim columnaAEliminar3 As Range
Set columnaAEliminar3 = ActiveSheet.Rows(1).Find("Columna3", LookIn:=xlValues, LookAt:=xlWhole)

If Not columnaAEliminar3 Is Nothing Then
columnaAEliminar3.EntireColumn.Delete
End If

Dim columnaAEliminar4 As Range
Set columnaAEliminar4 = ActiveSheet.Rows(1).Find("Columna4", LookIn:=xlValues, LookAt:=xlWhole)

If Not columnaAEliminar4 Is Nothing Then
columnaAEliminar4.EntireColumn.Delete
End If

Dim columnaAEliminar5 As Range
Set columnaAEliminar5 = ActiveSheet.Rows(1).Find("Columna5", LookIn:=xlValues, LookAt:=xlWhole)

If Not columnaAEliminar5 Is Nothing Then
columnaAEliminar5.EntireColumn.Delete
End If


Columns("AH:AH").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("AH2").Select
ActiveCell.FormulaR1C1 = _
"=DATE(MID(RC[-1],7,4),MID(RC[-1],4,2),MID(RC[-1],1,2))"
Range("AH2").Select
Selection.AutoFill Destination:=Range("AH2:AH" & Range("AG" & Rows.Count).End(xlUp).Row)
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("AH2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AG1").Select
Application.CutCopyMode = False
Selection.Copy
Range("AH1").Select
ActiveSheet.Paste
Columns("AG:AG").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft

Columns("AI:AI").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("AI2").Select
ActiveCell.FormulaR1C1 = _
"=DATE(MID(RC[-1],7,4),MID(RC[-1],4,2),MID(RC[-1],1,2))"
Range("AI2").Select
Selection.AutoFill Destination:=Range("AI2:AI" & Range("AH" & Rows.Count).End(xlUp).Row)
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("AI2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AH1").Select
Application.CutCopyMode = False
Selection.Copy
Range("AI1").Select
ActiveSheet.Paste
Columns("AH:AH").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft

ActiveWorkbook.Close SaveChanges:=True

End With
xFileName = Dir
Loop
End If

End Sub

ojala pudieran ayudarme porque no entiendo a que se debe ese cambio ya que me vuelve locas esas columnas.
Muchas gracias
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
Imágen de perfil de Antoni Masana
Val: 4.908
Oro
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

cambio de , por .

Publicado por Antoni Masana (2478 intervenciones) el 28/03/2023 15:54:31
Digamos que esto es una macro bien presentada.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
Sub Macro_contratos_1B()
    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
 
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.xls*")
        Do While xFileName <> ""
            With Workbooks.Open(xFdItem & xFileName)
                Range("A:E").Columns.Delete
 
                Dim Fila As Long
 
                For Fila = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
                    If WorksheetFunction.CountA(ActiveSheet.Rows(Fila)) = 0 Then
                         Cells(Fila, 1).EntireRow.Delete
                    End If
                Next Fila
 
 
                Range("A1").Select
                If AutoFilter = OFF Then Selection.AutoFilter
                ActiveSheet.Range("$A$1:$CG$124286").AutoFilter Field:=1, Criteria1:="< 100000", Operator:=xlFilterValues
                ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
 
                Range("A1").Select
                If AutoFilter = OFF Then Selection.AutoFilter
                ActiveSheet.Range("$A$1:$CG$124286").AutoFilter Field:=1, Criteria1:="=", Operator:=xlFilterValues
                ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
 
                Range("A1").Select
                If AutoFilter = OFF Then Selection.AutoFilter
                ActiveSheet.Range("$A$1:$CG$124286").AutoFilter Field:=1, Criteria1:="C-Nº contr", Operator:=xlFilterValues
                ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
 
                Range("A1").Select
                If AutoFilter = OFF Then Selection.AutoFilter
                ActiveSheet.Range("$A$1:$CG$124286").AutoFilter Field:=1, Criteria1:="SI", Operator:=xlFilterValues
                ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
                If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
 
 
                Set MR = Range("A1:BE1")
                For Each cell In MR
                    If cell.Value = Empty Then cell.EntireColumn.ClearContents
                Next
 
                Dim n As Integer 'nº columnas
                Dim i As Integer
                Dim col As String
 
                n = ActiveSheet.UsedRange.Columns.Count
                For i = n To 1 Step -1
                    If WorksheetFunction.CountA(Cells(1, i).EntireColumn) = Empty Then
                        Cells(1, i).EntireColumn.Delete
                    End If
                Next i
 
                ActiveSheet.Range("T1:T" & Range("T" & Rows.Count).End(xlUp).Row).Replace ",", "."
                ActiveSheet.Range("Y1:Y" & Range("Y" & Rows.Count).End(xlUp).Row).Replace ",", "."
 
                RutaArchivo = "C:\Users\u15285\Desktop\CONTRATOS\Archivos excel\"
                NombreArchivo = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4)
 
                ActiveWorkbook.SaveAs Filename:=RutaArchivo & NombreArchivo & ".xlsx", FileFormat:=51
 
                Selection.AutoFilter
 
                Range("A1").Select
                ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$BE$" & _
                                                        Range("K" & Rows.Count).End(xlUp).Row), , xlYes).Name = "Tabla3"
                Range("Tabla3[#All]").Select
 
                Columns("H:H").Select
                Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
                Range("H2").Select
                ActiveCell.FormulaR1C1 = "=DATE(MID(RC[-1],7,4),MID(RC[-1],4,2),MID(RC[-1],1,2))"
                Range("H2").Select
                Selection.AutoFill Destination:=Range("H2:H" & Range("G" & Rows.Count).End(xlUp).Row)
 
                Range(Selection, Selection.End(xlDown)).Select
                Selection.Copy
                Range("H2").Select
                Selection.PasteSpecial Paste:=xlPasteValues, _
                                       Operation:=xlNone, _
                                       SkipBlanks:=False, _
                                       Transpose:=False
 
                Range("G1").Select
                Application.CutCopyMode = False
                Selection.Copy
                Range("H1").Select
                ActiveSheet.Paste
                Columns("G:G").Select
                Application.CutCopyMode = False
                Selection.Delete Shift:=xlToLeft
 
                Columns("I:I").Select
                Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
                Range("I2").Select
                ActiveCell.FormulaR1C1 = "=DATE(MID(RC[-1],7,4),MID(RC[-1],4,2),MID(RC[-1],1,2))"
                Range("I2").Select
                Selection.AutoFill Destination:=Range("I2:I" & Range("H" & Rows.Count).End(xlUp).Row)
 
                Range(Selection, Selection.End(xlDown)).Select
                Selection.Copy
                Range("I2").Select
                Selection.PasteSpecial Paste:=xlPasteValues, _
                                       Operation:=xlNone, _
                                       SkipBlanks:=False, _
                                       Transpose:=False
 
                Range("H1").Select
                Application.CutCopyMode = False
                Selection.Copy
                Range("I1").Select
                ActiveSheet.Paste
                Columns("H:H").Select
                Application.CutCopyMode = False
                Selection.Delete Shift:=xlToLeft
 
                Columns("D:D").Select
                Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
                Range("D2").Select
                ActiveCell.FormulaR1C1 = "=DATE(MID(RC[-1],7,4),MID(RC[-1],4,2),MID(RC[-1],1,2))"
                Range("D2").Select
                Selection.AutoFill Destination:=Range("D2:D" & Range("C" & Rows.Count).End(xlUp).Row)
 
                Range(Selection, Selection.End(xlDown)).Select
                Selection.Copy
                Range("D2").Select
                Selection.PasteSpecial Paste:=xlPasteValues, _
                                       Operation:=xlNone, _
                                       SkipBlanks:=False, _
                                       Transpose:=False
                Range("C1").Select
                Application.CutCopyMode = False
                Selection.Copy
                Range("D1").Select
                ActiveSheet.Paste
                Columns("C:C").Select
                Application.CutCopyMode = False
                Selection.Delete Shift:=xlToLeft
 
 
                Dim columnaAEliminar As Range
                Set columnaAEliminar = ActiveSheet.Rows(1).Find("Columna1", LookIn:=xlValues, LookAt:=xlWhole)
 
                If Not columnaAEliminar Is Nothing Then
                	columnaAEliminar.EntireColumn.Delete
                End If
 
                Dim columnaAEliminar2 As Range
                Set columnaAEliminar2 = ActiveSheet.Rows(1).Find("Columna2", LookIn:=xlValues, LookAt:=xlWhole)
 
                If Not columnaAEliminar2 Is Nothing Then
                	columnaAEliminar2.EntireColumn.Delete
                End If
 
                Dim columnaAEliminar3 As Range
                Set columnaAEliminar3 = ActiveSheet.Rows(1).Find("Columna3", LookIn:=xlValues, LookAt:=xlWhole)
 
                If Not columnaAEliminar3 Is Nothing Then
                	columnaAEliminar3.EntireColumn.Delete
                End If
 
                Dim columnaAEliminar4 As Range
                Set columnaAEliminar4 = ActiveSheet.Rows(1).Find("Columna4", LookIn:=xlValues, LookAt:=xlWhole)
 
                If Not columnaAEliminar4 Is Nothing Then
                	columnaAEliminar4.EntireColumn.Delete
                End If
 
                Dim columnaAEliminar5 As Range
                Set columnaAEliminar5 = ActiveSheet.Rows(1).Find("Columna5", LookIn:=xlValues, LookAt:=xlWhole)
 
                If Not columnaAEliminar5 Is Nothing Then
                	columnaAEliminar5.EntireColumn.Delete
                End If
 
 
                Columns("AH:AH").Select
                Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
                Range("AH2").Select
                ActiveCell.FormulaR1C1 = "=DATE(MID(RC[-1],7,4),MID(RC[-1],4,2),MID(RC[-1],1,2))"
                Range("AH2").Select
 
                Selection.AutoFill Destination:=Range("AH2:AH" & Range("AG" & Rows.Count).End(xlUp).Row)
                Range(Selection, Selection.End(xlDown)).Select
                Selection.Copy
                Range("AH2").Select
                Selection.PasteSpecial Paste:=xlPasteValues, _
                                       Operation:=xlNone, _
                                       SkipBlanks:=False, _
                                       Transpose:=False
                Range("AG1").Select
                Application.CutCopyMode = False
                Selection.Copy
                Range("AH1").Select
                ActiveSheet.Paste
                Columns("AG:AG").Select
                Application.CutCopyMode = False
                Selection.Delete Shift:=xlToLeft
 
                Columns("AI:AI").Select
                Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
                Range("AI2").Select
                ActiveCell.FormulaR1C1 = "=DATE(MID(RC[-1],7,4),MID(RC[-1],4,2),MID(RC[-1],1,2))"
                Range("AI2").Select
                Selection.AutoFill Destination:=Range("AI2:AI" & Range("AH" & Rows.Count).End(xlUp).Row)
                Range(Selection, Selection.End(xlDown)).Select
                Selection.Copy
                Range("AI2").Select
                Selection.PasteSpecial Paste:=xlPasteValues, _
                                       Operation:=xlNone, _
                                       SkipBlanks:=False, _
                                       Transpose:=False
                Range("AH1").Select
                Application.CutCopyMode = False
                Selection.Copy
                Range("AI1").Select
                ActiveSheet.Paste
                Columns("AH:AH").Select
                Application.CutCopyMode = False
                Selection.Delete Shift:=xlToLeft
 
                ActiveWorkbook.Close SaveChanges:=True
            End With
            xFileName = Dir
        Loop
    End If
End Sub

Como no se que lees, de donde lees, que escribes, donde lo escribes, que haces y porque lo haces no se que carajo hace esta macro.
Comentarios CERO, que ayudar a entender una macro o código de programa, poco o nada.

Dependiendo de como tengas definido tu excel interpreta los signos de miles y decimales de una forma u otra.
Si el origen es un fichero EXCEL es indiferente como lo tienen en otra máquina, por ejemplo COMA para los miles y en tu máquina esta el PUNTO para los miles, al abrir el libro hace la conversión, de hecho la conversión es solo la forma en que muestra los datos en pantalla.

Si el problema esta al pasar los datos de un libro a otro es porque haces algo mal en la macro y como no ser que lees y que quieres hacer no te puedo decir donde esta el fallo.

Por poner un ejemplo no es lo mismo transportar piedras que huevos, unos se rompen con facilidad y los otros no.

Saludos.
\\//_
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar