vba数据有效性代码怎么写

1. vba查询代码怎么写

2. vba复制代码怎么写

3. vba删除代码怎么写

vba查询代码怎么写

1.EXCEL VBA 中关于查询代码如何编写

问题太笼统，给你个例子看吧

Public Sub dsa()

Dim iObjRange As Range: Set iObjRange = Range("A1:A10000") '对比的目标区域

Dim iFindRange As Range: Set iFindRange = Range("K:K") '查找的目标区域

Dim iResult As Range: Set iResult = Range("J:J") '结果的输出区域

Dim iCell As Range, iFind As Range

For Each iCell In iObjRange

If iCell <> "" Then

'下面这句是主要的查询语句

Set iFind = iFindRange.Find(iCell.Value, LookIn:=xlValues, LookAt:=xlWhole)

If iFind Is Nothing Then

iResult.Cells(iCell.Row, 1).Value = "N"

Else

iResult.Cells(iCell.Row, 1).Value = "Y"

End If

End Sub

2.vba查询代码

1、查询第B到J列（也包括L到S列）内的内容，如果查询到，则返回第A列（或第K列内）的值。请问代码应该怎么写？？

For M=1 to 最大行数

If Sheet1.Cells(M, 2).Value="搜寻值" Then '第2列代表合并后的B到J列

Msgbox Sheet1.Cells(M, 1).Value '返回第A列内容

End If

If Sheet1.Cells(M, 12).Value="搜寻值" Then '第12列代表合并后的L到S列

Msgbox Sheet1.Cells(M, 11).Value '返回第K列内容

End If

2、把几列或几行进行合并居中后，这个单元格应该如何用坐标表示呢？？

是以合并单元格中那个最左最上角的单元格坐标为准，如上面第一题的回答。

记得给分，：）

----------------------------------------------------------------------

1、查询第B到J列（也包括L到S列）内的内容，Sheet1.Cells(M, 2).Value="搜寻值" Then ，这个必须要全部字符串匹配吧，事实上我只查询这个单元格内的某一个词组啊。

那可以用模糊查询：If Instr(Sheet1.Cells(M, 2).Value，"搜寻值"）>0 Then

2、Msgbox Sheet1.Cells(M, 1).Value '返回第A列内容，

有可能查询到的第“M”行，并不是“最左最上角的单元格”，所以（M,1）其实是没有值的。怎么解决呢？

这个没有任何影响，也不会报错，例如第M行和第M+1行是行合并的单元格，且合并后的单元格内容为“测试”二字，则：

Msgbox Sheet1.Cells(M, 1).Value '返回的是“测试”二字

Msgbox Sheet1.Cells(M+1, 1).Value '返回的是“”空值，并不影响其他匹配和筛选操作、也不会报错，因此循环的时候就算轮到合并后的空行也没有关系的，你可以试试。

3.excel vba代码要怎么写

用如何代码可实现，假设原数据在A、B列

Sub main()

Set dic = CreateObject("scripting.dictionary")

arr = Range("A1").CurrentRegion

For i = 1 To UBound(arr)

If dic.exists(arr(i, 2)) = False Then

dic(arr(i, 2)) = arr(i, 1)

Else

If dic(arr(i, 2)) dic.Remove arr(i, 2)

dic(arr(i, 2)) = arr(i, 1)

End If

Next i

[E1].Resize(dic.Count, 1) = Application.Transpose(dic.keys)

[D1].Resize(dic.Count, 1) = Application.Transpose(dic.items)

End Sub

详细步骤如下：

1. 原数据

2. Alt+F11，选择sheet1，复制上述代码

3. 关闭返回工作表，alt+F8，掉出宏界面

4. 点击执行，即得到想要的结果：

4.请帮忙写一个Excel VBA查找的代码,不胜感激

Sub 查找北京或者上海（）

Dim arr

MyRow = ActiveSheet.[E65536].End(3).Row 'E例最后一行的行号

arr = Range("E1:E" & MyRow) 'E例字符串赋值给数组arr

For Each sh In arr '循环

I = I + 1

If InStr(sh， "上海") Or InStr(sh， "北京") <> 0 Then '如果数组字符串中包含上海或者北京

Range("E" & I).Select '选中对应的单元格

Selection.Interior.ColorIndex = 6 '单元格背景黄色

Selection.Font.ColorIndex = 3 '字体红色

End If

End Sub

5.怎么查看excel的VBA代码

按住ALT+F11弹出VBA编辑器。

只是要破解么？

新建一个Excel工作簿，Alt+F11 打开VBA编辑器，新建一个模块，复制以下代码，注意如提示变量未定义，则把Option Explicit行删除即可，经测试已经通过.

'移除VBA编码保护

Sub MoveProtect()

Dim FileName As String

FileName = Application.GetOpenFilename("Excel文件（*.xls & *.xla）,*.xls;*.xla", , "VBA破解"）

If FileName = CStr(False) Then

Exit Sub

Else

VBAPassword FileName, False

End If

End Sub

'设置VBA编码保护

Sub SetProtect()

Dim FileName As String

FileName = Application.GetOpenFilename("Excel文件（*.xls & *.xla）,*.xls;*.xla", , "VBA破解"）

If FileName = CStr(False) Then

Exit Sub

Else

VBAPassword FileName, True

End If

End Sub

Private Function VBAPassword(FileName As String, Optional Protect As Boolean = False)

If Dir(FileName) = "" Then

Exit Function

Else

FileCopy FileName, FileName & ".bak"

End If

Dim GetData As String * 5

Open FileName For Binary As #1

Dim CMGs As Long

Dim DPBo As Long

For i = 1 To LOF(1)

Get #1, i, GetData

If GetData = "CMG=""" Then CMGs = i

If GetData = "[Host" Then DPBo = i - 2: Exit For

If CMGs = 0 Then

MsgBox "请先对VBA编码设置一个保护密码。"， 32， "提示"

Exit Function

End If

If Protect = False Then

Dim St As String * 2

Dim s20 As String * 1

'取得一个0D0A十六进制字串

Get #1, CMGs - 2, St

'取得一个20十六制字串

Get #1, DPBo + 16, s20

'替换加密部份机码

For i = CMGs To DPBo Step 2

Put #1, i, St

'加入不配对符号

If (DPBo - CMGs) Mod 2 <> 0 Then

Put #1, DPBo + 1, s20

End If

MsgBox "文件解密成功。。"， 32， "提示"

Else

Dim MMs As String * 5

MMs = "DPB="""

Put #1, CMGs, MMs

MsgBox "对文件特殊加密成功。。"， 32， "提示"

End If

Close #1

End Function

6.vba查询代码

1、查询第B到J列（也包括L到S列）内的内容，如果查询到，则返回第A列（或第K列内）的值。

请问代码应该怎么写？？For M=1 to 最大行数 If Sheet1.Cells(M, 2).Value="搜寻值" Then '第2列代表合并后的B到J列 Msgbox Sheet1.Cells(M, 1).Value '返回第A列内容 End If If Sheet1.Cells(M, 12).Value="搜寻值" Then '第12列代表合并后的L到S列 Msgbox Sheet1.Cells(M, 11).Value '返回第K列内容 End IfNext2、把几列或几行进行合并居中后，这个单元格应该如何用坐标表示呢？？是以合并单元格中那个最左最上角的单元格坐标为准，如上面第一题的回答。记得给分，：） ----------------------------------------------------------------------1、查询第B到J列（也包括L到S列）内的内容，Sheet1.Cells(M, 2).Value="搜寻值" Then ，这个必须要全部字符串匹配吧，事实上我只查询这个单元格内的某一个词组啊。

那可以用模糊查询：If Instr(Sheet1.Cells(M, 2).Value，"搜寻值"）>0 Then2、Msgbox Sheet1.Cells(M, 1).Value '返回第A列内容，有可能查询到的第“M”行，并不是“最左最上角的单元格”，所以（M,1）其实是没有值的。怎么解决呢？这个没有任何影响，也不会报错，例如第M行和第M+1行是行合并的单元格，且合并后的单元格内容为“测试”二字，则：Msgbox Sheet1.Cells(M, 1).Value '返回的是“测试”二字Msgbox Sheet1.Cells(M+1, 1).Value '返回的是“”空值，并不影响其他匹配和筛选操作、也不会报错，因此循环的时候就算轮到合并后的空行也没有关系的，你可以试试。

vba查询代码怎么写

vba复制代码怎么写

1.excel用vba实现内容的复制代码怎么写

打开工作表，找到原数据，。

插入表单按钮。ALT+F11打开VBA代码编辑器，输入宏代码如下。

将表单按钮指定到宏，运行代码。查看运行后的效果，目标区域出现了和原数据一样的数据，但位置发生了变化。

输入的代码内容并解释。Sub 运行代码（）For i = 1 To 12Range("c" & i + 2) = Range("b" & i)Next iEnd Sub1.原数据单元格区域 b1 b2 b3 b4 到 b12;2.目标单元格区域出现 c3 c4 c5 c6 c7 到 c14;3.原数据区域在后，目标区域在前；4.目标区域和原数据之间的相同数据之间的位置变化：原数据与目标区域之间行号之差；5.使用FOR NEXT循环，步长为1，步长为目标单元格行号之差。

2.Excel VBA 复制特定行的代码该如何写

Sub aa()

i = Sheet1.[b65536].End(xlUp).Row

For j = 1 To i

If Sheet1.Cells(j, 2) = "C大队" Then

k = k + 1

Sheet1.Rows(j).Copy Sheet2.Cells(k, 1)

End If

End Sub

以上代码从SHEET1复制到SHEET2

3.请问VBA复制粘贴代码

Sub Demo()

' 最简洁的写法.

[A2] = [A1]

' 相对地址法.

Range("A2").Value = Range("A1").Value

' 绝对地址法.

Range("$A$2").Value = Range("$A$1").Value

' 利用 Cells 集合指定要写入的单元格.

Cells(2, 1).Value = Cells(1, 1).Value

End Sub

4.怎么用vba把vba代码复制粘贴

试试下面的代码：

Sub Macro1()

Dim MyPath$, MyName$, sh As Worksheet, m&, w As WorksheetFunction, wb As Workbook

Application.ScreenUpdating = False

Application.DisplayAlerts = False

Set w = WorksheetFunction

MyPath = ThisWorkbook.Path &； "\采集多数据"

MyName = Dir(MyPath & "*.xls*")

[a1].CurrentRegion.Offset(1).ClearContents

Do While MyName ""

With GetObject(MyPath & MyName)

With .Sheets(1)

If w.CountA(.UsedRange.Offset(1)) Then

m = m + 1

If m = 1 Then

Set wb = Workbooks.Add(xlWBATWorksheet)

Set sh = wb.ActiveSheet

.[a1].CurrentRegion.Copy sh.[a1]

Else

.[a1].CurrentRegion.Offset(1).Copy sh.[a65536].End(xlUp).Offset(1)

End If

End With

.Close False

End With

MyName = Dir

Loop

wb.SaveAs Filename:=ThisWorkbook.Path &； "\采集多数据20130422.xls", FileFormat:=xlExcel8

wb.Close

Application.ScreenUpdating = True

MsgBox "ok"

End Sub

5.复制表的vba代码

我的思路：在有模板的工作簿中，建立一个木块，并输入下列代码。

Sub 复制模板工作表（）

Dim W As Workbook '定义变量W为工作簿对象

For Each W In Workbooks '遍历已经打开的工作簿对象

If W Is Application.ThisWorkbook = False Then '如果W工作簿对象和代码所在工作簿对象比较，不相同，则执行。IS是比较运算符，比较两个对象是否相同，相同返回True，不相同返回False。你可以查基础书籍。

Application.ThisWorkbook.Worksheets（"模板"）.Copy After:=W.Worksheets(W.Worksheets.Count) '将代码所在工作簿中的模板工作表拷贝到W工作表的最后一个工作表之后。

End If

End Sub

我也是新手，不过喜欢！

6.excel VBA 复制sheet到另一表格的sheet 代码怎么写,详细如下

Dim Book2 As Workbook

Dim tmpSt As Worksheet

Set Book2 = Workbooks("2")

For Each tmpSt In ActiveWorkbook.Sheets

tmpSt.Activate

tmpSt.Cells.Select

Application.CutCopyMode = False

Selection.Copy

Select Case tmpSt.Name

Case "A"

Book2.Sheets（"数据1"）.Activate

Case "B"

Book2.Sheets（"数据2"）.Activate

Case "C"

Book2.Sheets（"数据3"）.Activate

Case "D"

Book2.Sheets（"数据4"）.Activate

Case "E"

Book2.Sheets（"数据5"）.Activate

Case "F"

Book2.Sheets（"数据6"）.Activate

Case "G"

Book2.Sheets（"数据7"）.Activate

Case "H"

Book2.Sheets（"数据8"）.Activate

End Select

ActiveSheet.Paste

前提是表1和2要打开，在表1运行。而且两个表的表名按你所述是已经建立的，如果表名不对应，将会运行错误。

vba删除代码怎么写

1. 如何用VBA代码删除编写代码的模块

你是想给别人一份没有宏的文件，那么换个思路，代码如下：

Sub test()

ThisWorkbook.Sheets.Copy

Sheets.Select

'Cells.Copy

'Cells.PasteSpecial Paste:=xlPasteValues

'Application.CutCopyMode = False

'Sheets(1).Select

ActiveWorkbook.SaveAs "tmp.xls"

ActiveWorkbook.Close

End Sub

去掉的部分代码可以将公式变为数值（需要的话，你再去掉'）。

2. excel vba,为什么写了vba代码,删除行的时候,提示这个,如图,

VBA删除行

通常是从下往上查找目标值进行删除

这样才会不会误删

Sub test()

For i = 2000 To 1 step -1

If Range("AQ" & i).Value = "0" or Range("AQ" & i).text = "#REF!" Then

Rows(i & ":" & i).Delete Shift:=xlUp

End If

End Sub

3. 请教如何在VBA中写代码删除已知行号的行

删除行的方法用错了，应该是：

Rows(rng.Row).Delete或者是：

rng.EntireRow.Delete

另外，在for循环中删除行是一个非常微妙的事情，因为当删除了一行以后，下一行将变成当前行，而NEXT命令之后，“下一行”就变成了被删除行之后的第二行，也就是会跳过一行。

因此，如果是For Each 。 Next这样的循环，就比较为难，建议另外用一个数组记录需要删除的行号，然后另外用一个循环进行删除操作。

或者是改用：

For r = 65536 to 1 Step -1从最后一行开始向上循环遍历，对于符合条件的行，用以下语句进行删除：

Rows(r).Delete题外话，为了提高程序效率，不要从第65536行开始循环，而是从有数据的最后一行开始：

For r = Range("A65536").End(xlUp).Row to 1 Step -1

4. excel VBA 怎么加删除代码

Sub test()

range("C3:D50000").clearcontents

For r = 3 To Range("A1").CurrentRegion.Rows.Count

URL = "http://XXXXXXX

With CreateObject("msxml2.xmlhttp")

.Open "GET", URL, False

.send

sp = Split(.responsetext, "~")

If UBound(sp) > 3 Then

Cells(r, 3).Value = sp(3)

Cells(r, 4).Value = Format(sp(30), "0000-00-00 00:00:00")

Else

Cells(r, 3).Value = "错！"

End If

End With

End Sub

5. VBA,怎么用代码删除 thisworkbook 里面的代码,

语句可以写，不过一般都会失败，因为默认是不允许访问VBA对象的，示例代码：

Set Wb = Nothing

MyPth = "xxx.xls"

Set Wb = GetObject(MyPth)

With Wb.VBProject.VBComponents.Item("ThisWorkbook").CodeModule

.DeleteLines 1, .CountOfLines

End With

Wb.Close True

6. vba,表格写3个代码,删除代码,加入代码,统计红色字体的出现次数

Sub 删除（）Dim r As Integer, rng As RangeWith Sheet1 r = .Cells(.Rows.Count, 1).End(3).Row If r < 55 Then Exit Sub .Rows(r + 1).Clear .Rows(r).Clear r1 = .Cells(.Rows.Count, 1).End(3).Row For j = 10 To 48 For i = r1 To r1 - 10 Step -1 If Len(Cells(i, j).Value) > 0 Then If Not Cells(i, j).Comment Is Nothing Then Cells(r1 + 1, j) = Cells(i, j).Comment.Text Exit For Else Cells(r1 + 1, j) = 0 End If Else Cells(r1 + 1, j) = "" End If Next NextEnd WithEnd SubSub 增加（）Dim r As Integer, rng As RangeWith Sheet1 r = .Cells(.Rows.Count, 1).End(3).Row Sheet2.Rows(r + 1).Copy Sheet1.Rows(r + 1) r1 = .Cells(.Rows.Count, 1).End(3).Row For j = 10 To 48 For i = r1 To r1 - 10 Step -1 If Len(Cells(i, j).Value) > 0 Then If Not Cells(i, j).Comment Is Nothing Then Cells(r1 + 1, j) = Cells(i, j).Comment.Text Exit For Else Cells(r1 + 1, j) = 0 End If Else Cells(r1 + 1, j) = "" End If Next NextEnd WithEnd Sub。

vba删除代码怎么写