Ejemplo 1: excel vba forzar elementos de matriz a alfanuméricos
'VBA function (extremely fast) to force an array column
'to ONLY alpha-numeric characters (with spaces):
Function ForceArrayColumnAlphaNumeric(v, Optional col& = 1)
Dim i&, j&, p&, max&, t&
Dim b() As Byte, res() As Byte, Keep(0 To 255) As Boolean
Const VALS$ = "0123456789 ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
For j = 1 To Len(VALS)
Keep(Asc(Mid$(VALS, j, 1))) = 1
Next
For i = LBound(v) To UBound(v)
p = 0
max = Len(v(i, col))
ReDim res(0 To max)
b = StrConv(v(i, col), vbFromUnicode)
For j = 0 To max - 1
t = b(j)
If Keep(t) Then
res(p) = t
p = p + 1
End If
Next
v(i, col) = StrConv(res, vbUnicode)
Next
End Function
'----------------------------------------------------------------------------------
array = [A1:Z999].Value2
ForceArrayColumnAlphaNumeric array, 3 '<--the 3rd column of array is now cleansed
'NB: Adjust the VALS$ constant to include only the characters you want to keep.
'NB: Array must be 2D. The column cleansed defaults to column 1.
Ejemplo 2: excel vba traducir texto
'Here is a VBA User Defined Function to translate text in an Excel cell. It
'uitlizes Google Translate and thus requires an Internet connection:
Function Translate$(sText$, FromLang$, ToLang$)
Dim p1&, p2&, url$, resp$
Const DIV_RESULT$ = "<divresult-container"">"
Const URL_TEMPLATE$ = "https://translate.google.com/m?hl=[from]&sl=[from]&tl=[to]&ie=UTF-8&prev=_m&q="
url = URL_TEMPLATE & WorksheetFunction.EncodeURL(sText)
url = Replace(url, "[to]", ToLang)
url = Replace(url, "[from]", FromLang)
resp = WorksheetFunction.WebService(url)
p1 = InStr(resp, DIV_RESULT)
If p1 Then
p1 = p1 + Len(DIV_RESULT)
p2 = InStr(p1, resp, "</div>")
Translate = Mid$(resp, p1, p2 - p1)
End If
End Function
'------------------------------------------------------------------------------
'With the following text in cell A1: Every moment is a fresh beginning.
'In cell B1, enter this formula:
=Translate(A1, "en", "fr") '<--translates text in A1 from English to French.
'The result in cell B1 will be: Chaque instant est un nouveau départ.
'Of course the Translate() function can be used directly from VBA as well:
MsgBox Translate([A1], "en", "de") '<--displays: Jeder Moment ist ein Neuanfang.
'And of course you may also manually use the Translate functionality
'built into Excel, which can be found on the Review tab of the
'Ribbon. But the UDF above provides a quick and streamlined method
'to translate text programmatically. Excel's translation capability
'is not exposed via the Excel Object Model, so a function like the
'above can be quite useful.
'The "FromLang" and "ToLang" arguments must be codes from the following table:
' CODE LANGUAGE
' en English
' fr French
' es Spanish
' it Italian
' de German
' af Afrikaans
' sq Albanian
' am Amharic
' ar Arabic
' hy Armenian
' az Azerbaijani
' eu Basque
' be Belarusian
' bn Bengali
' bs Bosnian
' bg Bulgarian
' ca Catalan
' ceb Cebuano
' ny Chichewa
' zh-CN Chinese (Simplified)
' zh-TW Chinese (Traditional)
' co Corsican
' hr Croatian
' cs Czech
' da Danish
' nl Dutch
' eo Esperanto
' et Estonian
' tl Filipino
' fi Finnish
' fy Frisian
' gl Galician
' ka Georgian
' el Greek
' gu Gujarati
' ht Haitian Creole
' ha Hausa
' haw Hawaiian
' iw Hebrew
' hi Hindi
' hmn Hmong
' hu Hungarian
' is Icelandic
' ig Igbo
' id Indonesian
' ga Irish
' ja Japanese
' jw Javanese
' kn Kannada
' kk Kazakh
' km Khmer
' rw Kinyarwanda
' ko Korean
' ku Kurdish (Kurmanji)
' ky Kyrgyz
' lo Lao
' la Latin
' lv Latvian
' lt Lithuanian
' lb Luxembourgish
' mk Macedonian
' mg Malagasy
' ms Malay
' ml Malayalam
' mt Maltese
' mi Maori
' mr Marathi
' mn Mongolian
' my Myanmar (Burmese)
' ne Nepali
' no Norwegian
' or Odia (Oriya)
' ps Pashto
' fa Persian
' pl Polish
' pt Portuguese
' pa Punjabi
' ro Romanian
' ru Russian
' sm Samoan
' gd Scots Gaelic
' sr Serbian
' st Sesotho
' sn Shona
' sd Sindhi
' si Sinhala
' sk Slovak
' sl Slovenian
' so Somali
' su Sundanese
' sw Swahili
' sv Swedish
' tg Tajik
' ta Tamil
' tt Tatar
' te Telugu
' th Thai
' tr Turkish
' tk Turkmen
' uk Ukrainian
' ur Urdu
' ug Uyghur
' uz Uzbek
' vi Vietnamese
' cy Welsh
' xh Xhosa
' yi Yiddish
' yo Yoruba
' zu Zulu
'
'
'
¡Haz clic para puntuar esta entrada!
(Votos: 0 Promedio: 0)