四方仙域传送阵 分享页面        

内容：

Attribute VB_Name = "东方仙盟_Macro_招标系统"
Dim 仙盟冥界 As Byte
Dim 仙盟冥界_人数 As Long
Dim ww冥界wht As Long
Dim 冥界保留 As Long
Dim 仙盟工作表_大屏幕偏移行数 As Integer

Sub 东方仙盟()
Attribute 东方仙盟.VB_ProcData.VB_Invoke_Func = " \n14"
'
' 东方仙盟 Macro
'

'
Range("F10").Select
ActiveCell.FormulaR1C1 = ""
Range("F9").Select
End Sub





Sub 仙盟创梦Macro_招标系统_启动()
Dim 仙盟工作表_专家库 As Worksheet, 仙盟工作表_大屏幕 As Worksheet ' 声明工作表变量
Dim 工程_名称 As String, 工程_公司 As String
Dim 工程_人数 As Long
Dim 工程_人数str As String
Dim 抽取i As Integer
仙盟工作表_大屏幕偏移行数 = 4

仙盟创梦Macro_招标系统_清空


' 通过名称引用工作表
On Error Resume Next
Set 仙盟工作表_专家库 = ThisWorkbook.Sheets("专家库") ' 替换为实际表名
Set 仙盟工作表_大屏幕 = ThisWorkbook.Sheets("大屏幕") ' 替换为实际表名

'仙盟工作表_专家库.Cells(2, 19) = "测试"
'工程_名称 = 仙盟工作表_大屏幕.Cells(3, 2)
'工程_公司 = 仙盟工作表_大屏幕.Cells(1, 1)
' 工程_人数str = 仙盟工作表_大屏幕.Cells(3, 5)
工程_名称 = 仙盟工作表_大屏幕.Cells(3, 4)
工程_公司 = 仙盟工作表_大屏幕.Cells(1, 3)
工程_人数str = 仙盟工作表_大屏幕.Cells(3, 7)

'On Error Resume Next
工程_人数str = Trim(工程_人数str)

If 工程_人数str = "" Then
MsgBox "专家人数不能为空: " & 工程_人数str, VbMsgBoxStyle.vbOKOnly, "专家招标系统" 'vbExclamation
Exit Sub
End If


工程_人数 = CLng(工程_人数str)
If Err.Number <> 0 Then
MsgBox "专家人数格式错误", vbExclamation
Exit Sub
End If


If 工程_人数 < 1 Then
MsgBox "专家人数错误: " & 工程_人数, VbMsgBoxStyle.vbOKOnly, "专家招标系统" 'vbExclamation
Exit Sub
End If

仙盟冥界_人数 = 工程_人数

Dim 专家随机数 As Integer

' 初始化随机数生成器（使用当前时间作为种子）
'‘ Randomize

' 生成2到70之间的随机整数
'randomNum = Int((70 - 2 + 1) * Rnd + 2)


Dim 专家库行数 As Long
Dim 大屏幕当前行 As Integer

专家库行数 = 仙盟创梦macro_招标系统_专家库非空行数(仙盟工作表_专家库)

' MsgBox "专家库行数: " & 专家库行数, VbMsgBoxStyle.vbOKOnly, "专家招标系统" 'vbExclamation
' For 抽取i = 1 To 工程_人数

'MsgBox "循环: " & 抽取i, VbMsgBoxStyle.vbOKOnly, "专家招标系统" 'vbExclamation
' Randomize
' 专家随机数 = Int((专家库行数 - 2 + 1) * Rnd + 2)
' 大屏幕当前行 = 仙盟工作表_大屏幕偏移行数 + 抽取i
' 仙盟创梦macro_招标系统_复制专家行_to大屏幕 仙盟工作表_专家库, 仙盟工作表_大屏幕, 专家随机数, 大屏幕当前行

' Next 抽取i

仙盟冥界 = 0
Do
For 抽取i = 1 To 工程_人数

'MsgBox "循环: " & 抽取i, VbMsgBoxStyle.vbOKOnly, "专家招标系统" 'vbExclamation
Randomize
专家随机数 = Int((专家库行数 - 2 + 1) * Rnd + 2)
大屏幕当前行 = 仙盟工作表_大屏幕偏移行数 + 抽取i
仙盟创梦macro_招标系统_复制专家行_to大屏幕 仙盟工作表_专家库, 仙盟工作表_大屏幕, 专家随机数, 大屏幕当前行, "Y"

Next 抽取i
DoEvents
Loop Until 仙盟冥界 = 1





End Sub


Sub 仙盟创梦Macro_招标系统_清空显示_数据(仙域 As Worksheet)
On Error Resume Next
'仙域.Range("A5:F20").ClearContents
仙域.Range("C5:H20").ClearContents

End Sub

Sub 仙盟创梦Macro_招标系统_清空显示_仙域(仙域 As Worksheet)
On Error Resume Next
'仙域.Range("A5:F20").Interior.ColorIndex = 36
仙域.Range("C5:H20").Interior.ColorIndex = 36
End Sub


Sub 仙盟创梦Macro_招标系统_清空()
Dim 仙盟工作表_大屏幕 As Worksheet ' 声明工作表变量



' 通过名称引用工作表
On Error Resume Next

Set 仙盟工作表_大屏幕 = ThisWorkbook.Sheets("大屏幕") ' 替换为实际表名
仙盟创梦Macro_招标系统_清空显示_数据 仙盟工作表_大屏幕
End Sub


Sub 仙盟创梦Macro_招标系统_停止()
On Error Resume Next

If k = 0 Then
仙盟冥界 = 1
End If
仙盟工作表_大屏幕偏移行数 = 4

If 仙盟冥界_人数 < 1 Then
MsgBox "请先抽取 ", VbMsgBoxStyle.vbOKOnly, "专家招标系统" 'vbExclamation
Exit Sub
End If



Dim 东部仙域 As Worksheet

Set 东部仙域 = ThisWorkbook.Sheets("大屏幕") ' 替换为实际表名
仙盟创梦Macro_招标系统_清空显示_仙域 东部仙域

仙盟创梦macro_招标系统_寻找指定名单列号


End Sub

Sub 仙盟创梦macro_招标系统_复制专家行_to大屏幕(西部仙域 As Worksheet, 东部仙域 As Worksheet, 西部灵体 As Integer, 东部灵体 As Integer, 变窟 As String)
Dim 灵舟坐标 As Integer
Dim 灵舟移动 As Integer
灵舟坐标 = 2

For 灵体i = 1 To 6


灵舟移动 = 灵舟坐标 + 灵体i

东部仙域.Cells(东部灵体, 灵舟移动) = 西部仙域.Cells(西部灵体, 灵体i)

If 变窟 = "Y" Then

Dim 变窟灵体 As Integer
' 生成1-56的随机颜色索引
Randomize
变窟灵体 = Int((56 - 1 + 1) * Rnd + 1)
东部仙域.Cells(东部灵体, 灵舟移动).Interior.ColorIndex = 变窟灵体
End If

Next 灵体i


End Sub
Function 仙盟创梦macro_招标系统_专家库非空行数(表 As Worksheet) As Long
仙盟创梦macro_招标系统_专家库非空行数 = 表.UsedRange.rows.Count '- 1
' 仙盟创梦macro_招标系统_专家库非空行数 = 1000
End Function

Sub 仙盟创梦macro_招标系统_寻找指定名单列号()
Dim filePath As String
Dim fileContent As String

Dim lines() As String
Dim dataArray() As String
Dim lineCount As Long
Dim maxCols As Long
Dim i As Long, j As Long

Dim 仙盟权重文件名单() As String

' 文件路径
filePath = "C:\CyberWin\Pro\招标系统\macro_人员权重.ini"

' 检查文件是否存在
If Dir(filePath) = "" Then
'MsgBox "文件不存在: " & filePath, vbExclamation
Exit Sub
End If

' 读取文件内容
'On Error Resume Next
'fileContent = ReadFileContent(filePath)
'仙盟创梦macro_招标系统_读取文件
'ReadTextFile_FSO
'fileContent = 仙盟创梦macro_招标系统_读取文件(filePath)
fileContent = 仙盟创梦macro_招标系统_读取文件2(filePath)
If Err.Number <> 0 Then
'MsgBox "读取文件时出错: " & Err.Description, vbCritical
Exit Sub
End If
On Error GoTo 0

' 按行分割内容
lines = Split(fileContent, vbCrLf)
lineCount = UBound(lines) + 1


'MsgBox "行数= " & lineCount, vbCritical
'MsgBox "行数内容= " & fileContent, vbCritical

' 重新定义数组大小
'ReDim dataArray(1 To lineCount, 1 To maxCols)

' 填充数组
For i = 0 To UBound(lines)
If Len(Trim(lines(i))) > 0 Then
'Dim cols() As String
仙盟权重文件名单 = Split(lines(i), ",") ' 假设使用逗号分隔，根据实际情况修改

maxCols = UBound(仙盟权重文件名单) '+ 1 ' UBound返回最大下标，+1得到元素个数

'For j = 0 To UBound(cols)
' dataArray(i + 1, j + 1) = cols(j)
'Next j
End If
Next i

ww冥界wht = maxCols
'MsgBox "ww冥界wht= " & ww冥界wht, VbMsgBoxStyle.vbOKOnly, "专家招标系统" 'vbExclamation

If maxCols < 1 Then
Exit Sub

End If
' MsgBox "ww冥界wht= " & ww冥界wht, VbMsgBoxStyle.vbOKOnly, "专家招标系统" 'vbExclamation

' 在新工作表中显示数据（可选）
'DisplayDataInWorksheet dataArray, lineCount, maxCols
'DisplayDataInWorksheet 仙盟权重文件名单, lineCount, maxCols
仙盟创梦macro_招标系统_专家库寻找指定名单 仙盟权重文件名单, lineCount, maxCols

' 现在可以使用dataArray数组进行后续处理
'MsgBox "文件已成功读取并解析为数组!", vbInformation
End Sub

Sub 仙盟创梦macro_招标系统_专家库寻找指定名单(dataArray() As String, rows As Long, cols As Long)
'Dim 仙盟工作表合集 As ThisWorkbook.Sheets
'仙盟工作表合集
' ThisWorkbook.Sheets.

Dim 仙盟工作表_专家库 As Worksheet, 仙盟工作表_大屏幕 As Worksheet ' 声明工作表变量



' 通过名称引用工作表
On Error Resume Next
Set 仙盟工作表_专家库 = ThisWorkbook.Sheets("专家库") ' 替换为实际表名
Set 仙盟工作表_大屏幕 = ThisWorkbook.Sheets("大屏幕") ' 替换为实际表名

'Dim 仙盟工作表_专家库 As Worksheet ' 声明工作表变量
Dim i As Long, j As Long, 权重i As Long, 专家库i As Integer


' 通过名称引用工作表
On Error Resume Next
'Set 仙盟工作表_专家库 = ThisWorkbook.Sheets("专家库") ' 替换为实际表名

Dim 专家库行数 As Long
' 专家库行数 = 仙盟创梦macro_招标系统_专家库非空行数("专家库")
专家库行数 = 仙盟创梦macro_招标系统_专家库非空行数(仙盟工作表_专家库)

'仙盟工作表_专家库.Cells(2, 19) = "测试"

'MsgBox "专家库行数=" & 专家库行数, vbInformation

Dim ww冥界wht2 As Integer

ww冥界wht2 = ww冥界wht + 1

冥界保留 = ww冥界wht

'MsgBox "姓名=!" & "仙盟冥界_人数=" & 仙盟冥界_人数 & "ww冥界wht2=" & ww冥界wht2, vbInformation


If 仙盟冥界_人数 >= ww冥界wht2 Then
冥界保留 = ww冥界wht
End If

If ww冥界wht2 > 仙盟冥界_人数 Then
冥界保留 = 仙盟冥界_人数
End If

'MsgBox "姓名=!" & "仙盟冥界_人数=" & 仙盟冥界_人数 & "冥界保留=" & 冥界保留, vbInformation

冥界保留 = 冥界保留 - 1


For 权重i = 0 To 冥界保留 'cols 保留
Dim 权重姓名 As String
权重姓名 = dataArray(权重i)
权重姓名 = Trim(权重姓名)

Dim 新列2 As Long
新列2 = 权重i + 14
仙盟工作表_专家库.Cells(权重i, 新2列) = "测试" & 权重姓名

For 专家库i = 2 To 专家库行数
Dim 姓名 As String
姓名 = 仙盟工作表_专家库.Cells(专家库i, 2)
Dim 大屏幕当前行 As Integer, 专家行当前 As Integer
专家行当前 = 专家库i

姓名 = Trim(姓名)
'MsgBox "姓名=!" & 姓名 & "专家库i=" & 专家库i, vbInformation
'Exit Sub
If 权重姓名 = 姓名 Then
仙盟工作表_专家库.Cells(专家库i, 7) = "找到" & 专家库i & "-" & 权重姓名
专家库i = 专家库行数





大屏幕当前行 = 仙盟工作表_大屏幕偏移行数 + 权重i + 1

仙盟创梦macro_招标系统_复制专家行_to大屏幕 仙盟工作表_专家库, 仙盟工作表_大屏幕, 专家行当前, 大屏幕当前行, "N"

' MsgBox "姓名=!" & 姓名 & "专家库i=" & 专家行当前 & "大屏幕当前行=" & 大屏幕当前行, vbInformation

Exit For
' Exit Sub
Else
Dim 新列 As Long
新列 = 权重i + 7
'仙盟工作表_专家库.Cells(专家库i, 新列) = "不找到" & 权重姓名
End If

Next 专家库i


Next 权重i




End Sub


Function 仙盟创梦macro_招标系统_专家库非空行数2(表 As String) As Long
Dim 仙盟工作表_专家库 As Worksheet
Dim 非空行计数 As Long
Dim dataRange As Range

Set 仙盟工作表_专家库 = ThisWorkbook.Sheets(表)

' 假设数据在A列到E列
On Error Resume Next
'Set dataRange = 仙盟工作表_专家库.Range("A:F")
On Error GoTo 0



If Not 仙盟工作表_专家库 Is Nothing Then
' 统计至少有一个非空单元格的行数
'Dim dataRange As Range
Set dataRange = 仙盟工作表_专家库.UsedRange
MsgBox "工作表为空!" & UBound(dataRange), vbExclamation
If Not dataRange Is Nothing Then
数据行计数 = Evaluate("SUMPRODUCT(--(MMULT(--(dataRange<>""""),ROW(dataRange)^0)>0))")
MsgBox "包含数据的行数: " & 数据行计数
Else
MsgBox "工作表为空!", vbExclamation
End If
Else
MsgBox "找不到工作表: " & 表, vbExclamation
End If

仙盟创梦macro_招标系统_专家库非空行数2 = 数据行计数
End Function

' 在工作表中显示数组数据的辅助函数
Sub DisplayDataInWorksheet(dataArray() As String, rows As Long, cols As Long)
Dim ws As Worksheet

' 创建新工作表
Set ws = ThisWorkbook.Sheets.Add
ws.Name = "人员权重数据3"

' 填充数据
Dim i As Long, j As Long
For i = 1 To rows
For j = 1 To cols
'ws.Cells(i, j).Value = dataArray(i, j)
ws.Cells(i, j).Value = dataArray(j)
Next j
Next i

' 自动调整列宽
ws.Columns.AutoFit
End Sub

' 读取文件内容的辅助函数
Function ReadFileContent(filePath As String) As String
Dim fileNum As Integer
Dim content As String

fileNum = FreeFile

Open filePath For Input As #fileNum
content = Input$(LOF(fileNum), #fileNum)
Close #fileNum

ReadFileContent = content
End Function

Function 仙盟创梦macro_招标系统_读取文件(filePath As String) As String

' 方法一：使用FSO
fileContent = ReadTextFile_FSO(filePath)
If fileContent <> "" Then
MsgBox "文件内容长度: " & Len(fileContent), vbInformation
End If
仙盟创梦macro_招标系统_读取文件 = fileContent

End Function

Function 仙盟创梦macro_招标系统_读取文件2(filePath As String) As String
Dim fso As Object
Dim file As Object

' 创建FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")

' 检查文件是否存在
If fso.FileExists(filePath) Then
' 打开文件并读取全部内容
Set file = fso.OpenTextFile(filePath, 1, False) ' 1 = ForReading
ReadTextFile_FSO = file.ReadAll
file.Close
Else
MsgBox "文件不存在: " & filePath, vbExclamation
ReadTextFile_FSO = ""
End If

' 释放对象
Set file = Nothing
Set fso = Nothing
仙盟创梦macro_招标系统_读取文件2 = ReadTextFile_FSO
End Function